Released DG*5.3*699 SEQ #628 Extracted from mail message **KIDS**:DG*5.3*699^ **INSTALL NAME** DG*5.3*699 "BLD",6649,0) DG*5.3*699^REGISTRATION^0^3060517^y "BLD",6649,1,0) ^^2^2^3060310^ "BLD",6649,1,1,0) This patch allows the patient security check to account for proxy users, "BLD",6649,1,2,0) and protects a system variable before displaying patient record flags. "BLD",6649,4,0) ^9.64PA^^ "BLD",6649,"KRN",0) ^9.67PA^8989.52^19 "BLD",6649,"KRN",.4,0) .4 "BLD",6649,"KRN",.401,0) .401 "BLD",6649,"KRN",.402,0) .402 "BLD",6649,"KRN",.403,0) .403 "BLD",6649,"KRN",.5,0) .5 "BLD",6649,"KRN",.84,0) .84 "BLD",6649,"KRN",3.6,0) 3.6 "BLD",6649,"KRN",3.8,0) 3.8 "BLD",6649,"KRN",9.2,0) 9.2 "BLD",6649,"KRN",9.8,0) 9.8 "BLD",6649,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",6649,"KRN",9.8,"NM",1,0) DGPFAPI^^0^B32207494 "BLD",6649,"KRN",9.8,"NM",2,0) DGSEC4^^0^B43657348 "BLD",6649,"KRN",9.8,"NM","B","DGPFAPI",1) "BLD",6649,"KRN",9.8,"NM","B","DGSEC4",2) "BLD",6649,"KRN",19,0) 19 "BLD",6649,"KRN",19.1,0) 19.1 "BLD",6649,"KRN",101,0) 101 "BLD",6649,"KRN",409.61,0) 409.61 "BLD",6649,"KRN",771,0) 771 "BLD",6649,"KRN",870,0) 870 "BLD",6649,"KRN",8989.51,0) 8989.51 "BLD",6649,"KRN",8989.52,0) 8989.52 "BLD",6649,"KRN",8994,0) 8994 "BLD",6649,"KRN","B",.4,.4) "BLD",6649,"KRN","B",.401,.401) "BLD",6649,"KRN","B",.402,.402) "BLD",6649,"KRN","B",.403,.403) "BLD",6649,"KRN","B",.5,.5) "BLD",6649,"KRN","B",.84,.84) "BLD",6649,"KRN","B",3.6,3.6) "BLD",6649,"KRN","B",3.8,3.8) "BLD",6649,"KRN","B",9.2,9.2) "BLD",6649,"KRN","B",9.8,9.8) "BLD",6649,"KRN","B",19,19) "BLD",6649,"KRN","B",19.1,19.1) "BLD",6649,"KRN","B",101,101) "BLD",6649,"KRN","B",409.61,409.61) "BLD",6649,"KRN","B",771,771) "BLD",6649,"KRN","B",870,870) "BLD",6649,"KRN","B",8989.51,8989.51) "BLD",6649,"KRN","B",8989.52,8989.52) "BLD",6649,"KRN","B",8994,8994) "BLD",6649,"QUES",0) ^9.62^^ "BLD",6649,"REQB",0) ^9.611^3^2 "BLD",6649,"REQB",2,0) DG*5.3*684^1 "BLD",6649,"REQB",3,0) DG*5.3*554^1 "BLD",6649,"REQB","B","DG*5.3*554",3) "BLD",6649,"REQB","B","DG*5.3*684",2) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 699^3060517 "PKG",5,22,1,"PAH",1,1,0) ^^2^2^3060517 "PKG",5,22,1,"PAH",1,1,1,0) This patch allows the patient security check to account for proxy users, "PKG",5,22,1,"PAH",1,1,2,0) and protects a system variable before displaying patient record flags. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","DGPFAPI") 0^1^B32207494^B32121180 "RTN","DGPFAPI",1,0) DGPFAPI ;ALB/RBS - PRF EXTERNAL API'S ; 2/28/05 11:21am "RTN","DGPFAPI",2,0) ;;5.3;Registration;**425,554,699**;Aug 13, 1993 "RTN","DGPFAPI",3,0) ; "RTN","DGPFAPI",4,0) Q ;no direct entry "RTN","DGPFAPI",5,0) ; "RTN","DGPFAPI",6,0) GETACT(DGDFN,DGPRF) ;Retrieve all ACTIVE Patient record flag assignments "RTN","DGPFAPI",7,0) ;The purpose of this API is to facilitate the retrieval of specific "RTN","DGPFAPI",8,0) ;data that can be used for the displaying of or the reporting of "RTN","DGPFAPI",9,0) ;only ACTIVE Patient Record Flag (PRF) Assignment information for "RTN","DGPFAPI",10,0) ;a patient. "RTN","DGPFAPI",11,0) ; "RTN","DGPFAPI",12,0) ; Associated DBIA: #3860 - DGPF PATIENT RECORD FLAG "RTN","DGPFAPI",13,0) ; "RTN","DGPFAPI",14,0) ; Input: "RTN","DGPFAPI",15,0) ; DGDFN - IEN of patient in the PATIENT (#2) file "RTN","DGPFAPI",16,0) ; DGPRF - Closed Root array of return values "RTN","DGPFAPI",17,0) ; [Optional-default DGPFAPI] "RTN","DGPFAPI",18,0) ; "RTN","DGPFAPI",19,0) ; Output: "RTN","DGPFAPI",20,0) ; Function result - "0" = No Active record flags for the patient "RTN","DGPFAPI",21,0) ; - "nn" = Total number of flags returned in array "RTN","DGPFAPI",22,0) ; DGPRF() - Array, passed by closed root reference "RTN","DGPFAPI",23,0) ; - Multiple subscripted array of Active flag information "RTN","DGPFAPI",24,0) ; If the function call is successful, this array will "RTN","DGPFAPI",25,0) ; contain each of the Active flag records. "RTN","DGPFAPI",26,0) ; - Subscript field value = internal value^external value "RTN","DGPFAPI",27,0) ; 2 piece string caret(^) delimited "RTN","DGPFAPI",28,0) ; DGPFAPI() - Default array name if no name passed "RTN","DGPFAPI",29,0) ; "RTN","DGPFAPI",30,0) ; Subscript Field Name Field #/File # "RTN","DGPFAPI",31,0) ; --------- ---------- -------------- "RTN","DGPFAPI",32,0) ; "APPRVBY" APPROVED BY (.05)/(#26.14) "RTN","DGPFAPI",33,0) ; (Note: The .5 (POSTMASTER) internal field value "RTN","DGPFAPI",34,0) ; triggers an output transform that converts the "RTN","DGPFAPI",35,0) ; external value of "POSTMASTER" to "CHIEF OF STAFF". "RTN","DGPFAPI",36,0) ; "ASSIGNDT" DATE/TIME (.02)/(#26.14) "RTN","DGPFAPI",37,0) ; "REVIEWDT" REVIEW DATE (.06)/(#26.13) "RTN","DGPFAPI",38,0) ; "FLAG" FLAG NAME (.02)/(#26.13) "RTN","DGPFAPI",39,0) ; "FLAGTYPE" TYPE (.03)/(#26.11 or #26.15) "RTN","DGPFAPI",40,0) ; "CATEGORY" National or Local Flag (#26.15) or (#26.11) "RTN","DGPFAPI",41,0) ; "OWNER" OWNER SITE (.04)/(#26.13) "RTN","DGPFAPI",42,0) ; "ORIGSITE" ORIGINATING SITE (.05)/(#26.13) "RTN","DGPFAPI",43,0) ; "TIUTITLE" TIU PN TITLE (.07)/(#26.11) or (#26.15) "RTN","DGPFAPI",44,0) ; "TIULINK" TIU PN LINK (.06)/(#26.14) "RTN","DGPFAPI",45,0) ; "NARR" ASSIGNMENT NARRATIVE (1)/(#26.13) "RTN","DGPFAPI",46,0) ; (word-processing, multiple nodes) "RTN","DGPFAPI",47,0) ; The format is in a word-processing value that may "RTN","DGPFAPI",48,0) ; contain multiple nodes of text. Each node of text "RTN","DGPFAPI",49,0) ; will be less than 80 characters in length. "RTN","DGPFAPI",50,0) ; The format is as follows: "RTN","DGPFAPI",51,0) ; TARGET_ROOT(nn,"NARR",line#,0)=text "RTN","DGPFAPI",52,0) ; where: "RTN","DGPFAPI",53,0) ; nn = a unique number for each Flag "RTN","DGPFAPI",54,0) ; line# = a unique number starting at 1 for each wp line "RTN","DGPFAPI",55,0) ; of narrative text "RTN","DGPFAPI",56,0) ; 0 = standard subscript format for the nodes of a "RTN","DGPFAPI",57,0) ; FileMan Word Processing field "RTN","DGPFAPI",58,0) ; "RTN","DGPFAPI",59,0) N DGPFTCNT ;return results, "0"=no flags, "nn"=number of flags "RTN","DGPFAPI",60,0) N DGPFIENS ;array of all active flag assignment IEN's "RTN","DGPFAPI",61,0) N DGPFIEN ;ien of record flag assignment in (#26.13) file "RTN","DGPFAPI",62,0) N DGPFA ;flag assignment array "RTN","DGPFAPI",63,0) N DGPFAH ;flag assignment history array "RTN","DGPFAPI",64,0) N DGPFLAG ;flag record array "RTN","DGPFAPI",65,0) N DGCAT ;flag category "RTN","DGPFAPI",66,0) ; "RTN","DGPFAPI",67,0) Q:'$G(DGDFN) 0 ;Quit, null parameter "RTN","DGPFAPI",68,0) Q:'$$GETALL^DGPFAA(DGDFN,.DGPFIENS,1) 0 ;Quit, no Active assign's "RTN","DGPFAPI",69,0) ; "RTN","DGPFAPI",70,0) S DGPRF=$G(DGPRF) "RTN","DGPFAPI",71,0) I DGPRF']"" S DGPRF="DGPFAPI" ;setup default array name "RTN","DGPFAPI",72,0) ; "RTN","DGPFAPI",73,0) K @DGPRF ;Kill/initialize work array "RTN","DGPFAPI",74,0) ; "RTN","DGPFAPI",75,0) S (DGPFIEN,DGCAT)="",DGPFTCNT=0 "RTN","DGPFAPI",76,0) ; "RTN","DGPFAPI",77,0) ; loop all returned Active Record Flag Assignment ien's "RTN","DGPFAPI",78,0) F S DGPFIEN=$O(DGPFIENS(DGPFIEN)) Q:DGPFIEN="" D "RTN","DGPFAPI",79,0) . K DGPFA,DGPFAH,DGPFLAG "RTN","DGPFAPI",80,0) . ; "RTN","DGPFAPI",81,0) . ; retrieve single assignment record fields "RTN","DGPFAPI",82,0) . Q:'$$GETASGN^DGPFAA(DGPFIEN,.DGPFA) "RTN","DGPFAPI",83,0) . ; "RTN","DGPFAPI",84,0) . ; no patient DFN match "RTN","DGPFAPI",85,0) . I DGDFN'=$P(DGPFA("DFN"),U) Q "RTN","DGPFAPI",86,0) . ; "RTN","DGPFAPI",87,0) . ; get initial assignment history "RTN","DGPFAPI",88,0) . Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGPFIEN),.DGPFAH) "RTN","DGPFAPI",89,0) . ; "RTN","DGPFAPI",90,0) . ; get record flag record "RTN","DGPFAPI",91,0) . Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGPFLAG) "RTN","DGPFAPI",92,0) . ; "RTN","DGPFAPI",93,0) . S DGPFTCNT=DGPFTCNT+1 "RTN","DGPFAPI",94,0) . ; "RTN","DGPFAPI",95,0) . ; approved by user "RTN","DGPFAPI",96,0) . S @DGPRF@(DGPFTCNT,"APPRVBY")=$G(DGPFAH("APPRVBY")) "RTN","DGPFAPI",97,0) . ; "RTN","DGPFAPI",98,0) . ; initial assignment date/time "RTN","DGPFAPI",99,0) . S @DGPRF@(DGPFTCNT,"ASSIGNDT")=$G(DGPFAH("ASSIGNDT")) "RTN","DGPFAPI",100,0) . ; "RTN","DGPFAPI",101,0) . ; next review due date "RTN","DGPFAPI",102,0) . S @DGPRF@(DGPFTCNT,"REVIEWDT")=$G(DGPFA("REVIEWDT")) "RTN","DGPFAPI",103,0) . ; "RTN","DGPFAPI",104,0) . ; record flag name "RTN","DGPFAPI",105,0) . S @DGPRF@(DGPFTCNT,"FLAG")=$G(DGPFA("FLAG")) "RTN","DGPFAPI",106,0) . ; "RTN","DGPFAPI",107,0) . ; record flag type "RTN","DGPFAPI",108,0) . S @DGPRF@(DGPFTCNT,"FLAGTYPE")=$G(DGPFLAG("TYPE")) "RTN","DGPFAPI",109,0) . ; "RTN","DGPFAPI",110,0) . ; category of flag - I (NATIONAL) or II (LOCAL) "RTN","DGPFAPI",111,0) . S DGCAT=$S($G(DGPFA("FLAG"))["26.15":"I (NATIONAL)",1:"II (LOCAL)") "RTN","DGPFAPI",112,0) . S @DGPRF@(DGPFTCNT,"CATEGORY")=DGCAT_U_DGCAT "RTN","DGPFAPI",113,0) . ; "RTN","DGPFAPI",114,0) . ; owner site "RTN","DGPFAPI",115,0) . S @DGPRF@(DGPFTCNT,"OWNER")=$G(DGPFA("OWNER")) "RTN","DGPFAPI",116,0) . ; "RTN","DGPFAPI",117,0) . ; originating site "RTN","DGPFAPI",118,0) . S @DGPRF@(DGPFTCNT,"ORIGSITE")=$G(DGPFA("ORIGSITE")) "RTN","DGPFAPI",119,0) . ; "RTN","DGPFAPI",120,0) . ; only add TIU Progress Note subscripts if owner site of assignment "RTN","DGPFAPI",121,0) . I $P($$SITE^VASITE,U)=$P(DGPFA("OWNER"),U) D "RTN","DGPFAPI",122,0) . . ; get last history record (most current) "RTN","DGPFAPI",123,0) . . K DGPFAH "RTN","DGPFAPI",124,0) . . Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGPFIEN),.DGPFAH) "RTN","DGPFAPI",125,0) . . ; "RTN","DGPFAPI",126,0) . . ; flag associated TIU PN Title "RTN","DGPFAPI",127,0) . . S @DGPRF@(DGPFTCNT,"TIUTITLE")=$G(DGPFLAG("TIUTITLE")) "RTN","DGPFAPI",128,0) . . ; "RTN","DGPFAPI",129,0) . . ; assignment history TIU PN Link "RTN","DGPFAPI",130,0) . . S @DGPRF@(DGPFTCNT,"TIULINK")=$G(DGPFAH("TIULINK")) "RTN","DGPFAPI",131,0) . ; "RTN","DGPFAPI",132,0) . ; narrative "RTN","DGPFAPI",133,0) . I '$D(DGPFA("NARR",1,0)) D Q ;should never happen - but - "RTN","DGPFAPI",134,0) . . S @DGPRF@(DGPFTCNT,"NARR",1,0)="No Narrative Text" "RTN","DGPFAPI",135,0) . ; "RTN","DGPFAPI",136,0) . M @DGPRF@(DGPFTCNT,"NARR")=DGPFA("NARR") "RTN","DGPFAPI",137,0) ; "RTN","DGPFAPI",138,0) ; Re-Sort Active flags by category & alpha flag name "RTN","DGPFAPI",139,0) I +$G(DGPFTCNT)>1 D "RTN","DGPFAPI",140,0) . I $$SORT^DGPFUT2(DGPRF) ;naked IF to just do resort "RTN","DGPFAPI",141,0) ; "RTN","DGPFAPI",142,0) Q DGPFTCNT "RTN","DGPFAPI",143,0) ; "RTN","DGPFAPI",144,0) PRFQRY(DGDFN) ;query the CMOR for all patient record flag assignments "RTN","DGPFAPI",145,0) ;This function queries a given patient's Coordinated Master of Record "RTN","DGPFAPI",146,0) ;(CMOR) site to retrieve all patient record flag assignments for the "RTN","DGPFAPI",147,0) ;patient. The function will only succeed when the QRY HL7 interface "RTN","DGPFAPI",148,0) ;is enabled, the patient has a national Integrated Control Number "RTN","DGPFAPI",149,0) ;(ICN), the patient's CMOR is not the local site and the HL7 query "RTN","DGPFAPI",150,0) ;receives an ACK from the CMOR site. "RTN","DGPFAPI",151,0) ; "RTN","DGPFAPI",152,0) ; Input: "RTN","DGPFAPI",153,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFAPI",154,0) ; "RTN","DGPFAPI",155,0) ; Output: "RTN","DGPFAPI",156,0) ; Function value - 1 on success, 0 on failure "RTN","DGPFAPI",157,0) ; "RTN","DGPFAPI",158,0) N DGRSLT "RTN","DGPFAPI",159,0) N DGQRY "RTN","DGPFAPI",160,0) ; "RTN","DGPFAPI",161,0) S DGRSLT=0 "RTN","DGPFAPI",162,0) ; "RTN","DGPFAPI",163,0) S DGQRY=+$$QRYON^DGPFPARM() "RTN","DGPFAPI",164,0) I DGQRY D "RTN","DGPFAPI",165,0) . S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,DGQRY) "RTN","DGPFAPI",166,0) ; "RTN","DGPFAPI",167,0) Q DGRSLT "RTN","DGPFAPI",168,0) ; "RTN","DGPFAPI",169,0) DISPPRF(DGDFN) ;display active patient record flag assignments "RTN","DGPFAPI",170,0) ;This procedure performs a lookup for active patient record flag "RTN","DGPFAPI",171,0) ;assignments for a given patient and formats the assignment data for "RTN","DGPFAPI",172,0) ;roll-and-scroll display. "RTN","DGPFAPI",173,0) ; "RTN","DGPFAPI",174,0) ; Input: "RTN","DGPFAPI",175,0) ; DGDFN - pointer to patient in PATIENT (#2) file "RTN","DGPFAPI",176,0) ; "RTN","DGPFAPI",177,0) ; Output: "RTN","DGPFAPI",178,0) ; none "RTN","DGPFAPI",179,0) ; "RTN","DGPFAPI",180,0) Q:'$D(XQY0) "RTN","DGPFAPI",181,0) Q:$P(XQY0,U)="DGPF RECORD FLAG ASSIGNMENT" "RTN","DGPFAPI",182,0) ; "RTN","DGPFAPI",183,0) ;protect Kernel IO variables "RTN","DGPFAPI",184,0) N IOBM,IOBOFF,IOBON,IOEDEOP,IOINHI,IOINORM,IORC,IORVOFF,IORVON,IOIL "RTN","DGPFAPI",185,0) N IOSC,IOSGRO,IOSTBM,IOTM,IOUOFF,IOUON "RTN","DGPFAPI",186,0) ; "RTN","DGPFAPI",187,0) ;protect ListMan variables "RTN","DGPFAPI",188,0) N VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCC,VALMCNT,VALMCOFF,VALMCON "RTN","DGPFAPI",189,0) N VALMDDF,VALMDN,VALMEVL,VALMHDR,VALMIOXY,VALMKEY,VALMLFT,VALMLST "RTN","DGPFAPI",190,0) N VALMMENU,VALMPGE,VALMSGR,VALMUP,VALMWD "RTN","DGPFAPI",191,0) ; "RTN","DGPFAPI",192,0) ;protect Unwinder variables "RTN","DGPFAPI",193,0) N ORU,ORUDA,ORUER,ORUFD,ORUFG,ORUSB,ORUSQ,ORUSV,ORUT,ORUW,ORUX "RTN","DGPFAPI",194,0) N XQORM "RTN","DGPFAPI",195,0) ; "RTN","DGPFAPI",196,0) ; protect original Listman VALM DATA global "RTN","DGPFAPI",197,0) K ^TMP($J,"DGPFVALM DATA") "RTN","DGPFAPI",198,0) M ^TMP($J,"DGPFVALM DATA")=^TMP("VALM DATA",$J) "RTN","DGPFAPI",199,0) ; "RTN","DGPFAPI",200,0) D DISPPRF^DGPFUT1(DGDFN) "RTN","DGPFAPI",201,0) ; "RTN","DGPFAPI",202,0) ; restore original Listman VALM DATA global "RTN","DGPFAPI",203,0) M ^TMP("VALM DATA",$J)=^TMP($J,"DGPFVALM DATA") "RTN","DGPFAPI",204,0) ; "RTN","DGPFAPI",205,0) K ^TMP($J,"DGPFVALM DATA") "RTN","DGPFAPI",206,0) Q "RTN","DGSEC4") 0^2^B43657348^B41969635 "RTN","DGSEC4",1,0) DGSEC4 ;ALB/MM,JAP - Utilities for record access & sensitive record processing;10/6/99 ; 10/26/05 12:46pm "RTN","DGSEC4",2,0) ;;5.3;Registration;**249,281,391,471,684,699**;Aug 13, 1993 "RTN","DGSEC4",3,0) ; "RTN","DGSEC4",4,0) ;Line tags OWNREC & SENS moved from DGSEC in DG*5.3*249 when DGSEC "RTN","DGSEC4",5,0) ;reached the maximum routine size. "RTN","DGSEC4",6,0) ; "RTN","DGSEC4",7,0) PTSEC(RESULT,DFN,DGMSG,DGOPT) ;RPC/API entry point for patient sensitive & record access checks "RTN","DGSEC4",8,0) ;Output array (Required) "RTN","DGSEC4",9,0) ; RESULT(1)= -1-RPC/API failed "RTN","DGSEC4",10,0) ; Required variable not defined "RTN","DGSEC4",11,0) ; 0-No display/action required "RTN","DGSEC4",12,0) ; Not accessing own, employee, or sensitive record "RTN","DGSEC4",13,0) ; 1-Display warning message "RTN","DGSEC4",14,0) ; Sensitive and DG SENSITIVITY key holder "RTN","DGSEC4",15,0) ; or Employee and DG SECURITY OFFICER key holder "RTN","DGSEC4",16,0) ; 2-Display warning message/require OK to continue "RTN","DGSEC4",17,0) ; Sensitive and not a DG SENSITIVITY key holder "RTN","DGSEC4",18,0) ; Employee and not a DG SECURITY OFFICER key holder "RTN","DGSEC4",19,0) ; 3-Access to record denied "RTN","DGSEC4",20,0) ; Accessing own record "RTN","DGSEC4",21,0) ; 4-Access to Patient (#2) file records denied "RTN","DGSEC4",22,0) ; SSN not defined "RTN","DGSEC4",23,0) ; RESULT(2-10) = error or display messages "RTN","DGSEC4",24,0) ; "RTN","DGSEC4",25,0) ;Input parameters: DFN = Patient file entry (Required) "RTN","DGSEC4",26,0) ; DGMSG = If 1, generate message (optional) "RTN","DGSEC4",27,0) ; DGOPT = Option name^Menu text (Optional) "RTN","DGSEC4",28,0) ; "RTN","DGSEC4",29,0) K RESULT "RTN","DGSEC4",30,0) I $G(DFN)="" D Q "RTN","DGSEC4",31,0) .S RESULT(1)=-1 "RTN","DGSEC4",32,0) .S RESULT(2)="Required variable missing." "RTN","DGSEC4",33,0) S DGMSG=$G(DGMSG) "RTN","DGSEC4",34,0) D OWNREC(.RESULT,DFN,$G(DUZ),DGMSG) "RTN","DGSEC4",35,0) I RESULT(1)=1 S RESULT(1)=3 Q "RTN","DGSEC4",36,0) I RESULT(1)=2 S RESULT(1)=4 Q "RTN","DGSEC4",37,0) K RESULT "RTN","DGSEC4",38,0) D SENS(.RESULT,DFN,$G(DUZ)) "RTN","DGSEC4",39,0) I RESULT(1)=1 D "RTN","DGSEC4",40,0) .I $G(DUZ)="" D Q "RTN","DGSEC4",41,0) ..;DUZ must be defined to access sensitive record & update DG Security log "RTN","DGSEC4",42,0) ..S RESULT(1)=-1 "RTN","DGSEC4",43,0) ..S RESULT(2)="Your user code is undefined. This must be defined to access a restricted patient record." "RTN","DGSEC4",44,0) .D SETLOG1^DGSEC(DFN,DUZ,,$G(DGOPT)) "RTN","DGSEC4",45,0) Q "RTN","DGSEC4",46,0) NOTICE(RESULT,DFN,DGOPT,ACTION) ;RPC/API entry point for log entry and message generation "RTN","DGSEC4",47,0) ;Input parameters: "RTN","DGSEC4",48,0) ; DFN = Patient file DFN "RTN","DGSEC4",49,0) ; DGOPT = Option name^Menu text (Optional) "RTN","DGSEC4",50,0) ; ACTION = 1 - Set DG Security Log entry, 2 - Generate mail "RTN","DGSEC4",51,0) ; message, 3 - Both (Optional - Defaults to both) "RTN","DGSEC4",52,0) ; "RTN","DGSEC4",53,0) ;Output: RESULT = 1 - DG Security Log updated and/or Sensitive Record msg sent (Determined by ACTION value) "RTN","DGSEC4",54,0) ; 0 - Required variable undefined "RTN","DGSEC4",55,0) ; "RTN","DGSEC4",56,0) I $G(DFN)="" S RESULT=0 Q "RTN","DGSEC4",57,0) I $G(DUZ)="" S RESULT=0 Q "RTN","DGSEC4",58,0) S DGOPT=$G(DGOPT) "RTN","DGSEC4",59,0) I $G(ACTION)="" S ACTION=3 "RTN","DGSEC4",60,0) I ACTION'=1 D BULTIN1^DGSEC(DFN,DUZ,DGOPT) "RTN","DGSEC4",61,0) I ACTION'=2 D SETLOG1^DGSEC(DFN,DUZ,,DGOPT) "RTN","DGSEC4",62,0) S RESULT=1 "RTN","DGSEC4",63,0) Q "RTN","DGSEC4",64,0) ; "RTN","DGSEC4",65,0) OWNREC(DGREC,DFN,DGDUZ,DGMSG,DGNEWPT,DGPTSSN) ;Determine if user accessing his/her own Patient file (#2) record "RTN","DGSEC4",66,0) ;Input: "RTN","DGSEC4",67,0) ; DGREC - Array name passed by reference "RTN","DGSEC4",68,0) ; DFN - Patient (#2) file IEN "RTN","DGSEC4",69,0) ; DGDUZ - New Person (#200) file IEN (Not required. If not sent will return 0.) "RTN","DGSEC4",70,0) ; DGMSG - If 1, generate message (Optional) Will default to 1 "RTN","DGSEC4",71,0) ; DGNEWPT - Set to 1 when adding a new entry to the Patient file "RTN","DGSEC4",72,0) ; DGPTSSN - new patient's SSN "RTN","DGSEC4",73,0) ; DGNEWPT & DGPTSSN parameters only defined if DPTLK is adding "RTN","DGSEC4",74,0) ; a new Patient (#2) file entry "RTN","DGSEC4",75,0) ; "RTN","DGSEC4",76,0) ;Output: "RTN","DGSEC4",77,0) ; DGREC(1)=0 - Not attempting to access own Patient (#2) file record, "RTN","DGSEC4",78,0) ; DUZ not defined, RESTRICT PATIENT RECORD ACCESS parameter "RTN","DGSEC4",79,0) ; in MAS Parameters (#43) file not set to yes, or user holds "RTN","DGSEC4",80,0) ; DG RECORD ACCESS security key. "RTN","DGSEC4",81,0) ; =1 - Attempting to access own Patient file record "RTN","DGSEC4",82,0) ; =2 - SSN undefined "RTN","DGSEC4",83,0) ; =-1 - Required variable not defined. "RTN","DGSEC4",84,0) ; Other nodes in array will contain error message text. "RTN","DGSEC4",85,0) ; "RTN","DGSEC4",86,0) ;DFN required "RTN","DGSEC4",87,0) I '$D(DFN),($G(DGNEWPT)'=1) D Q "RTN","DGSEC4",88,0) .S DGREC(1)=-1 "RTN","DGSEC4",89,0) .S DGREC(2)="DFN not defined." "RTN","DGSEC4",90,0) S DGREC(1)=0 "RTN","DGSEC4",91,0) ;Check if parameter is on "RTN","DGSEC4",92,0) I +$P($G(^DG(43,1,"REC")),U)=0 Q "RTN","DGSEC4",93,0) N DGNPSSN "RTN","DGSEC4",94,0) ;I $D(DUZ)=0 Q "RTN","DGSEC4",95,0) I (+$G(DGDUZ))<1 Q "RTN","DGSEC4",96,0) ;Check if user holds security key "RTN","DGSEC4",97,0) I $D(^XUSEC("DG RECORD ACCESS",DGDUZ)) Q "RTN","DGSEC4",98,0) I $G(DGMSG)="" S DGMSG=1 "RTN","DGSEC4",99,0) N DGNPERR "RTN","DGSEC4",100,0) ; quit if user is a proxy user, i.e., not a real person "RTN","DGSEC4",101,0) I $$ACTIVE^XUSAP(DGDUZ),$$USERTYPE^XUSAP(DGDUZ,"CONNECTOR PROXY")!($$USERTYPE^XUSAP(DGDUZ,"APPLICATION PROXY")) Q "RTN","DGSEC4",102,0) S DGNPSSN=$$GET1^DIQ(200,DGDUZ_",",9,"I","","DGNPERR") "RTN","DGSEC4",103,0) I 'DGNPSSN D Q "RTN","DGSEC4",104,0) .S DGREC(1)=2 "RTN","DGSEC4",105,0) .S DGREC(2)="Your SSN is missing from the NEW PERSON file. Contact your ADP Coordinator." "RTN","DGSEC4",106,0) .;Only send message if parameter set to 1 "RTN","DGSEC4",107,0) .I DGMSG=1 D MSG(DGDUZ) "RTN","DGSEC4",108,0) I +$G(DGNEWPT)'=1 S DGPTSSN=$P($G(^DPT(DFN,0)),U,9) "RTN","DGSEC4",109,0) I +$G(DGNEWPT)=1 S DGPTSSN=$TR(DGPTSSN,"-","") "RTN","DGSEC4",110,0) I DGNPSSN=DGPTSSN D Q "RTN","DGSEC4",111,0) .S DGREC(1)=1 "RTN","DGSEC4",112,0) .S DGREC(2)="Security regulations prohibit computer access to your own medical record." "RTN","DGSEC4",113,0) Q "RTN","DGSEC4",114,0) MSG(DGDUZ) ;Send Missing SSN in New Person file message to mailgroup "RTN","DGSEC4",115,0) ;Input: DGDUZ - New Person (#200) file IEN (Required) "RTN","DGSEC4",116,0) ; "RTN","DGSEC4",117,0) N DGNPERR,DGNPNAME,DGTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ "RTN","DGSEC4",118,0) S DGNPNAME=$$GET1^DIQ(200,DGDUZ_",",.01,"","DGNPERR") "RTN","DGSEC4",119,0) S XMSUB="MISSING SSN IN NEW PERSON FILE" "RTN","DGSEC4",120,0) S DGTEXT(1)="The following NEW PERSON record does not contain a Social Security Number." "RTN","DGSEC4",121,0) S DGTEXT(2)="This is required to access PATIENT file entries." "RTN","DGSEC4",122,0) S DGTEXT(3)="" "RTN","DGSEC4",123,0) S DGTEXT(4)=$S(DGNPNAME'="":DGNPNAME,1:"UNKNOWN") "RTN","DGSEC4",124,0) S DGTEXT(5)="NEW PERSON (#200) File Internal Entry Number (DUZ): "_+DGDUZ "RTN","DGSEC4",125,0) S DGTEXT(6)="" "RTN","DGSEC4",126,0) S DGTEXT(7)="This message has been sent to DG MISSING NEW PERSON SSN mail group." "RTN","DGSEC4",127,0) S DGTEXT(8)="Please take appropriate action." "RTN","DGSEC4",128,0) S XMTEXT="DGTEXT(" "RTN","DGSEC4",129,0) S XMDUZ=$S(DGNPNAME'="":DGNPNAME,1:.5) "RTN","DGSEC4",130,0) S XMY("G.DG MISSING NEW PERSON SSN")="" "RTN","DGSEC4",131,0) S XMCHAN=1 "RTN","DGSEC4",132,0) D ^XMD "RTN","DGSEC4",133,0) Q "RTN","DGSEC4",134,0) SENS(DGSENS,DFN,DGDUZ,DDS,DGSENFLG) ;Determine if sensitive record "RTN","DGSEC4",135,0) ;Input: "RTN","DGSEC4",136,0) ; DGSENS - Array name passed by reference "RTN","DGSEC4",137,0) ; DFN - Patient (#2) file IEN (Required) "RTN","DGSEC4",138,0) ; DGDUZ - New Person (#200) file IEN "RTN","DGSEC4",139,0) ; DDS - Screenman variable "RTN","DGSEC4",140,0) ; DGSENFLG - If defined, patient record sensitivity not checked "RTN","DGSEC4",141,0) ; "RTN","DGSEC4",142,0) ;Output: "RTN","DGSEC4",143,0) ; DGSENS(1)=0 - Record is not sensitive or DGSENFLG set "RTN","DGSEC4",144,0) ; =1 - Sensitive record and user holds DG SENSITIVITY key "RTN","DGSEC4",145,0) ; - Employee and user holds DG SECURITY OFFICER key "RTN","DGSEC4",146,0) ; =2 - Sensitive record and user does not hold key "RTN","DGSEC4",147,0) ; - Employee and user does not hold key "RTN","DGSEC4",148,0) ; =-1 - Required input variable not defined "RTN","DGSEC4",149,0) ; If 1, 2 or -1, array will contain error/display message "RTN","DGSEC4",150,0) ; "RTN","DGSEC4",151,0) N DGMSG,DGA1,DG1,DGDATE,DGLNE,DGT,DGTIME,DGEMPLEE "RTN","DGSEC4",152,0) ;Patient file DFN must be defined. "RTN","DGSEC4",153,0) I '$D(DFN) D Q "RTN","DGSEC4",154,0) .S DGSENS(1)=-1 "RTN","DGSEC4",155,0) .S DGSENS(2)="DFN not defined." "RTN","DGSEC4",156,0) S DGSENS(1)=0 "RTN","DGSEC4",157,0) I $D(DGSENFLG) Q "RTN","DGSEC4",158,0) ;Determine if patient is employee "RTN","DGSEC4",159,0) S DGEMPLEE=$$EMPL(DFN) "RTN","DGSEC4",160,0) ;Quit if not an employee & not found in DG Security Log file "RTN","DGSEC4",161,0) I 'DGEMPLEE,('$D(^DGSL(38.1,+DFN,0))) Q "RTN","DGSEC4",162,0) ;Quit if not an employee and not flagged as sensitive "RTN","DGSEC4",163,0) I 'DGEMPLEE,($P($G(^DGSL(38.1,+DFN,0)),U,2)'=1) Q "RTN","DGSEC4",164,0) ;DUZ & user name must be defined "RTN","DGSEC4",165,0) S DGMSG=$S('$G(DGDUZ):"user code",'$D(^VA(200,DGDUZ,0)):"user name",1:"") "RTN","DGSEC4",166,0) I DGMSG'="" D Q "RTN","DGSEC4",167,0) .S DGSENS(1)=-1 "RTN","DGSEC4",168,0) .S DGSENS(2)="Your "_DGMSG_" is undefined. This must be defined to access" "RTN","DGSEC4",169,0) .S DGSENS(3)=" a restricted patient record." "RTN","DGSEC4",170,0) S DGSENS(1)=1 "RTN","DGSEC4",171,0) ;Inpatient check - no longer used (kept for future reference) "RTN","DGSEC4",172,0) ;D H^DGUTL S DGT=DGTIME D ^DGPMSTAT "RTN","DGSEC4",173,0) S DGSENS(2)="***WARNING***" "RTN","DGSEC4",174,0) I $G(DDS)'="" S DGSENS(2)=DGSENS(2)_" ***RESTRICTED RECORD***" "RTN","DGSEC4",175,0) I $G(DDS)="" S DGSENS(3)="***RESTRICTED RECORD***" "RTN","DGSEC4",176,0) I DGEMPLEE,('$D(^XUSEC("DG SECURITY OFFICER",+$G(DGDUZ)))) D Q "RTN","DGSEC4",177,0) .S DGSENS(1)=2 "RTN","DGSEC4",178,0) .D PRIV "RTN","DGSEC4",179,0) I '$D(^XUSEC("DG SENSITIVITY",+$G(DGDUZ))) D "RTN","DGSEC4",180,0) .S DGSENS(1)=2 "RTN","DGSEC4",181,0) .D PRIV "RTN","DGSEC4",182,0) Q "RTN","DGSEC4",183,0) PRIV ;Privacy Act statement for DGSENS array "RTN","DGSEC4",184,0) S $P(DGLNE,"* ",38)="" "RTN","DGSEC4",185,0) I $G(DDS)="" S DGSENS(4)=DGLNE "RTN","DGSEC4",186,0) S DGSENS(5)="* This record is protected by the Privacy Act of 1974 and the Health *" "RTN","DGSEC4",187,0) S DGSENS(6)="* Insurance Portability and Accountability Act of 1996. If you elect *" "RTN","DGSEC4",188,0) S DGSENS(7)="* to proceed, you will be required to prove you have a need to know. *" "RTN","DGSEC4",189,0) S DGSENS(8)="* Accessing this patient is tracked, and your station Security Officer *" "RTN","DGSEC4",190,0) S DGSENS(9)="* will contact you for your justification. *" "RTN","DGSEC4",191,0) I $G(DDS)="" S DGSENS(10)=DGLNE "RTN","DGSEC4",192,0) Q "RTN","DGSEC4",193,0) EMPL(DFN,DGCHELIG) ;Does patient have any eligibility codes equal to "RTN","DGSEC4",194,0) ; EMPLOYEE "RTN","DGSEC4",195,0) ;Input: "RTN","DGSEC4",196,0) ; DFN - Patient (#2) file IEN (required). "RTN","DGSEC4",197,0) ; DGCHELIG - Flags to determine mode of execution (optional). "RTN","DGSEC4",198,0) ; Value of the parameter can contain any combination "RTN","DGSEC4",199,0) ; of the following characters: "RTN","DGSEC4",200,0) ; "P" - check primary eligibility code "RTN","DGSEC4",201,0) ; "S" - check secondary eligibility codes "RTN","DGSEC4",202,0) ; "RTN","DGSEC4",203,0) ; If this parameter is either not defined or set to an "RTN","DGSEC4",204,0) ; illegal value, the value of "PS" will be assumed. "RTN","DGSEC4",205,0) ;Output: "RTN","DGSEC4",206,0) ; 1 - Patient has EMPLOYEE as an eligibility code "RTN","DGSEC4",207,0) ; 0 - Patient doesn't have EMPLOYEE as an eligibility code "RTN","DGSEC4",208,0) ; "RTN","DGSEC4",209,0) ;Notes: EMPLOYEE is entry 14 in the MAS ELIGIBILITY CODE file (#8.1) "RTN","DGSEC4",210,0) N DGELIG,DGEMPLEE "RTN","DGSEC4",211,0) S DGEMPLEE=0 "RTN","DGSEC4",212,0) I $G(DGCHELIG)'["P",$G(DGCHELIG)'["S" S DGCHELIG="PS" "RTN","DGSEC4",213,0) ;Check primary eligibility "RTN","DGSEC4",214,0) I DGCHELIG["P" D "RTN","DGSEC4",215,0) .S DGELIG=+$G(^DPT(DFN,.36)) "RTN","DGSEC4",216,0) .I $D(^DIC(8,"D",14,DGELIG)) S DGEMPLEE=1 "RTN","DGSEC4",217,0) ;Check secondary eligibilities (if needed) "RTN","DGSEC4",218,0) I DGCHELIG["S",'DGEMPLEE D "RTN","DGSEC4",219,0) .S DGELIG=0 "RTN","DGSEC4",220,0) .F S DGELIG=+$O(^DPT("AEL",DFN,DGELIG)) Q:'DGELIG I $D(^DIC(8,"D",14,DGELIG)) S DGEMPLEE=1 Q "RTN","DGSEC4",221,0) Q DGEMPLEE "VER") 8.0^22.0 "BLD",6649,6) ^628 **END** **END**