- ORQPT2 ;HIRMFO/DAD - Patient Look-Up Security Check and Notification ;Jun 13, 2019@11:43
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
- ;
- EN1(ORDFN) ;
- ; Sensitive Patient record check
- ; Input
- ; ORDFN = Pointer to the Patient file (#2)
- ; Output
- ; 0 - Patient record IS NOT sensitive
- ; 1 - Patient record IS sensitive
- ;
- Q ''$$GET1^DIQ(38.1,+$G(ORDFN),2,"I")
- ;
- EN2(ORDFN) ;
- ; Update DG Security Log file (#38.1) and sends
- ; the 'Restricted Patient Accessed' bulletin to the
- ; mailgroup specified in the 'Sensitive Rec Accessed
- ; Group' field (43,509)
- ; Input
- ; ORDFN = Pointer to the Patient file (#2)
- ; Output
- ; None
- ;
- I $S($G(ORDFN)'>0:1,$G(DUZ)'>0:1,1:'$$EN1(ORDFN)) Q
- ;
- N DFN,DG1,DGA1,DGT,DGXFR0
- N ORINPT,ORINVNOW,ORMAILGR,ORNOW,OROPT
- N X,XQOPT
- ;
- D OP^XQCHK
- S OROPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
- S ORNOW=$E($$NOW^XLFDT,1,12)
- S DFN=ORDFN,DGT=ORNOW D EN^DGPMSTAT S ORINPT=$S(DG1:"y",1:"n")
- S ORMAILGR=$$GET1^DIQ(43,1,509)
- ;
- I ORINPT="n",'$D(^XUSEC("DG SENSITIVITY",DUZ)),ORMAILGR]"" D
- . N ORTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- . S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
- . S XMY("G."_ORMAILGR)=""
- . S XMTEXT="ORTEXT("
- . S XMDUZ=DUZ
- . S XMCHAN=1
- . S ORTEXT(1)="The following sensitive patient record has been accessed:"
- . S ORTEXT(2)=""
- . S ORTEXT(3)=" Patient Name: "_$$GET1^DIQ(2,ORDFN,.01)
- . S ORTEXT(4)=" Soc Sec Num : "_$$GET1^DIQ(2,ORDFN,.09)
- . S ORTEXT(5)=" Option Used : "_$P(OROPT,U,2)
- . D ^XMD
- . Q
- ;
- F L +^DGSL(38.1,ORDFN):1 Q:$T
- ;
- I '$D(^DGSL(38.1,ORDFN)) D
- . N ORFDA,ORIEN,ORMSG
- . S ORFDA(38.1,"+1,",.01)=ORDFN
- . S ORIEN(1)=ORDFN
- . D UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
- . Q
- F S ORINVNOW=9999999.9999-ORNOW Q:'$D(^DGSL(38.1,ORDFN,"D",ORINVNOW)) S ORNOW=ORNOW+.00001
- N ORFDA,ORIEN,ORMSG
- S ORFDA(38.11,"+1,"_ORDFN_",",.01)=ORNOW
- S ORFDA(38.11,"+1,"_ORDFN_",",2)=DUZ
- S ORFDA(38.11,"+1,"_ORDFN_",",3)=$P(OROPT,U,2)
- S ORFDA(38.11,"+1,"_ORDFN_",",4)=ORINPT
- S ORIEN(1)=ORINVNOW
- D UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
- ;
- L -^DGSL(38.1,ORDFN)
- ;
- Q
- ;
- CWAD(DFN) ;
- ; Crisis notes, clinical Warnings, Allergies, advance Directives
- ; Input:
- ; DFN = A Patient file (#2) IEN
- ; Output:
- ; A string of 0-6 nonrepeating characters consisting
- ; of the letters C,W,A,D,P,L. The string will be returned
- ; with the letters in the order shown.
- ;
- I $G(DFN)'>0 Q ""
- N ACRN,CTR,ORLST,MSG
- D ENCOVER^TIUPP3(DFN)
- ; ORLST initialized with lower case 'cwad' to generate
- ; correct ordering of letters. Lower case letter indicates
- ; that the patient does not have that item. Upper case
- ; indicates that the patient has the item.
- S ORLST="cwad"
- S CTR=0
- F S CTR=$O(^TMP("TIUPPCV",$J,CTR)) Q:(CTR'>0)!(ORLST?4U) D
- . S ACRN=$P($G(^TMP("TIUPPCV",$J,CTR)),U,2)
- . ; If patient has item, convert item to uppercase
- . I "^C^W^A^D^"[(U_ACRN_U) S ORLST=$TR(ORLST,$C($A(ACRN)+32),ACRN)
- . Q
- K ^TMP("TIUPPCV",$J)
- ; Remove any remaining lower case items
- S ORLST=$TR(ORLST,"cwad")
- S ORLST=ORLST_$$POSTSHRT^WVRPCOR(DFN)
- Q ORLST
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQPT2 3166 printed Jan 18, 2025@03:34:34 Page 2
- ORQPT2 ;HIRMFO/DAD - Patient Look-Up Security Check and Notification ;Jun 13, 2019@11:43
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
- +2 ;
- EN1(ORDFN) ;
- +1 ; Sensitive Patient record check
- +2 ; Input
- +3 ; ORDFN = Pointer to the Patient file (#2)
- +4 ; Output
- +5 ; 0 - Patient record IS NOT sensitive
- +6 ; 1 - Patient record IS sensitive
- +7 ;
- +8 QUIT ''$$GET1^DIQ(38.1,+$GET(ORDFN),2,"I")
- +9 ;
- EN2(ORDFN) ;
- +1 ; Update DG Security Log file (#38.1) and sends
- +2 ; the 'Restricted Patient Accessed' bulletin to the
- +3 ; mailgroup specified in the 'Sensitive Rec Accessed
- +4 ; Group' field (43,509)
- +5 ; Input
- +6 ; ORDFN = Pointer to the Patient file (#2)
- +7 ; Output
- +8 ; None
- +9 ;
- +10 IF $SELECT($GET(ORDFN)'>0:1,$GET(DUZ)'>0:1,1:'$$EN1(ORDFN))
- QUIT
- +11 ;
- +12 NEW DFN,DG1,DGA1,DGT,DGXFR0
- +13 NEW ORINPT,ORINVNOW,ORMAILGR,ORNOW,OROPT
- +14 NEW X,XQOPT
- +15 ;
- +16 DO OP^XQCHK
- +17 SET OROPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
- +18 SET ORNOW=$EXTRACT($$NOW^XLFDT,1,12)
- +19 SET DFN=ORDFN
- SET DGT=ORNOW
- DO EN^DGPMSTAT
- SET ORINPT=$SELECT(DG1:"y",1:"n")
- +20 SET ORMAILGR=$$GET1^DIQ(43,1,509)
- +21 ;
- +22 IF ORINPT="n"
- IF '$DATA(^XUSEC("DG SENSITIVITY",DUZ))
- IF ORMAILGR]""
- Begin DoDot:1
- +23 NEW ORTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- +24 SET XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
- +25 SET XMY("G."_ORMAILGR)=""
- +26 SET XMTEXT="ORTEXT("
- +27 SET XMDUZ=DUZ
- +28 SET XMCHAN=1
- +29 SET ORTEXT(1)="The following sensitive patient record has been accessed:"
- +30 SET ORTEXT(2)=""
- +31 SET ORTEXT(3)=" Patient Name: "_$$GET1^DIQ(2,ORDFN,.01)
- +32 SET ORTEXT(4)=" Soc Sec Num : "_$$GET1^DIQ(2,ORDFN,.09)
- +33 SET ORTEXT(5)=" Option Used : "_$PIECE(OROPT,U,2)
- +34 DO ^XMD
- +35 QUIT
- End DoDot:1
- +36 ;
- +37 FOR
- LOCK +^DGSL(38.1,ORDFN):1
- if $TEST
- QUIT
- +38 ;
- +39 IF '$DATA(^DGSL(38.1,ORDFN))
- Begin DoDot:1
- +40 NEW ORFDA,ORIEN,ORMSG
- +41 SET ORFDA(38.1,"+1,",.01)=ORDFN
- +42 SET ORIEN(1)=ORDFN
- +43 DO UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
- +44 QUIT
- End DoDot:1
- +45 FOR
- SET ORINVNOW=9999999.9999-ORNOW
- if '$DATA(^DGSL(38.1,ORDFN,"D",ORINVNOW))
- QUIT
- SET ORNOW=ORNOW+.00001
- +46 NEW ORFDA,ORIEN,ORMSG
- +47 SET ORFDA(38.11,"+1,"_ORDFN_",",.01)=ORNOW
- +48 SET ORFDA(38.11,"+1,"_ORDFN_",",2)=DUZ
- +49 SET ORFDA(38.11,"+1,"_ORDFN_",",3)=$PIECE(OROPT,U,2)
- +50 SET ORFDA(38.11,"+1,"_ORDFN_",",4)=ORINPT
- +51 SET ORIEN(1)=ORINVNOW
- +52 DO UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
- +53 ;
- +54 LOCK -^DGSL(38.1,ORDFN)
- +55 ;
- +56 QUIT
- +57 ;
- CWAD(DFN) ;
- +1 ; Crisis notes, clinical Warnings, Allergies, advance Directives
- +2 ; Input:
- +3 ; DFN = A Patient file (#2) IEN
- +4 ; Output:
- +5 ; A string of 0-6 nonrepeating characters consisting
- +6 ; of the letters C,W,A,D,P,L. The string will be returned
- +7 ; with the letters in the order shown.
- +8 ;
- +9 IF $GET(DFN)'>0
- QUIT ""
- +10 NEW ACRN,CTR,ORLST,MSG
- +11 DO ENCOVER^TIUPP3(DFN)
- +12 ; ORLST initialized with lower case 'cwad' to generate
- +13 ; correct ordering of letters. Lower case letter indicates
- +14 ; that the patient does not have that item. Upper case
- +15 ; indicates that the patient has the item.
- +16 SET ORLST="cwad"
- +17 SET CTR=0
- +18 FOR
- SET CTR=$ORDER(^TMP("TIUPPCV",$JOB,CTR))
- if (CTR'>0)!(ORLST?4U)
- QUIT
- Begin DoDot:1
- +19 SET ACRN=$PIECE($GET(^TMP("TIUPPCV",$JOB,CTR)),U,2)
- +20 ; If patient has item, convert item to uppercase
- +21 IF "^C^W^A^D^"[(U_ACRN_U)
- SET ORLST=$TRANSLATE(ORLST,$CHAR($ASCII(ACRN)+32),ACRN)
- +22 QUIT
- End DoDot:1
- +23 KILL ^TMP("TIUPPCV",$JOB)
- +24 ; Remove any remaining lower case items
- +25 SET ORLST=$TRANSLATE(ORLST,"cwad")
- +26 SET ORLST=ORLST_$$POSTSHRT^WVRPCOR(DFN)
- +27 QUIT ORLST