- DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 3/24/04 7:53pm
- ;;5.3;Registration;**32,46,197,214,249,281,352,391,425,582,769,796,964,1130**;Aug 13, 1993;Build 7
- ;Per VHA Directive 6402, this routine should not be modified.
- ;
- ;Entry point from DPTLK
- I +$G(Y)=+$G(^DISV(DUZ,"^DPT(")),$G(DPTBTDT) K DPTBTDT Q
- N DFN,DGANS,DGMSG,DGOPT,DGPTSSN,DGREC,DGSENS,DGY,DX,DY,%,DG1
- ;Y=Patient file DFN
- S DGY=Y
- ;OWNREC^DGSEC4 parameters:
- ; DGREC = output array passed by reference
- ; DGY = Patient file DFN
- ; DUZ = New Person file IEN
- ; 1=generate error msg
- ; DGNEWPT - set to 1 in DPTLK2 when adding new Patient (#2) file entry
- ; DGPTSSN - set to patient's SSN when adding new Patient file entry
- ; X=Patient's SSN from DPTLK2
- I $G(DGNEWPT)=1 S DGPTSSN=X
- D OWNREC^DGSEC4(.DGREC,+DGY,DUZ,1,$G(DGNEWPT),$G(DGPTSSN))
- S Y=DGY
- I DGREC(1)=1!(DGREC(1)=2) D G Q
- .S Y=-1
- .D DISP(.DGREC)
- .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME
- ;SENS^DGSEC4 parameters:
- ; DGSENS = output array passed by reference
- ; Y = Patient fileDFN
- ; DUZ = New Person file IEN
- ; DDS - Screenman variable
- ; DGSENFLG - If defined, patient record sensitivity not checked
- D SENS^DGSEC4(.DGSENS,+Y,DUZ,$G(DDS),.DGSENFLG)
- ;DUZ must be defined to access a sensitive record
- I DGSENS(1)=-1 D G Q
- .S Y=-1
- .D DISP(.DGSENS)
- I DGSENS(1)=0 D G Q
- .;DG*5.3*964 hook to call VistA Security Remediation Audit solution VAS
- .I $$GET1^DIQ(46.5,1,.02,"I") D SELAUD^DGAUDIT2(2,$G(DGY),"INQUIRY",$G(DGOPT))
- ;Get option name for DG Security Log file and bulletin
- D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
- I DGSENS(1)=1 D
- .I DIC(0)["E" D
- ..W $C(7)
- ..D DISP(.DGSENS)
- .I Y>0 D
- ..;Parameters: DFN,DUZ,,Option name^Menu text
- ..D SETLOG1(+Y,DUZ,,DGOPT)
- I DGSENS(1)=2 D
- .I DIC(0)["E" D
- ..W $C(7)
- ..D DISP2V
- ..D NOTCE1
- .I Y>0 D
- ..D SETLOG1(+Y,DUZ,,DGOPT)
- ..;Parameters: DFN,DUZ,Option name^Menu text,message array
- ..D BULTIN1(+Y,DUZ,DGOPT,.DGMSG)
- ..I $D(DGSM),DIC(0)["E" D DISP(.DGMSG)
- D Q
- Q
- ;
- REC ;DPTLK2 entry point when adding new Patient file record
- ;Input: X=Patient's SSN
- ;Output: DGREC=1 (adding own record or SSN not defined) or 0
- ;
- ;Parameters: DGREC=output array
- ; DUZ
- ; 1 - generate error msg
- ; DGNEWPT = 1 (adding new Patient (#2) file record
- ; DGPTSSN = X (Patient's SSN)
- N DGPTSSN
- S DGPTSSN=X
- D OWNREC^DGSEC4(.DGREC,,DUZ,1,$G(DGNEWPT),$G(DGPTSSN))
- I DGREC(1)=1!(DGREC(1)=2) D
- .D DISP(.DGREC)
- .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME
- S DGREC=+DGREC(1)
- I DGREC=2 S DGREC=1
- Q
- SETLOG ;Entry point for DBIA #2242
- ;Input variables: Y=DFN,DUZ,DG1=Inpatient/outpatient indicator,DGOPT=Option name^Menu text
- D SETLOG1(Y,DUZ,DG1,DGOPT)
- D Q
- Q
- BULTIN ;Entry point for DBIA #2242
- ;Input variables: Y=DFN,DUZ,DGOPT=Option name^Menu text
- D BULTIN1(Y,DUZ,DGOPT)
- Q
- SETLOG1(DFN,DGDUZ,DG1,DGOPT) ;Adds/updates entry in DG Security Log file (38.1)
- ;Input:
- ; DFN - Patient (#2) file DFN (Required)
- ; DGDUZ - New Person (#200) file IEN
- ; DG1 - Inpatient or Outpatient (Optional)
- ; DGOPT - Option (#19) file Name (#.01)^Menu text (Optional)
- ;
- N DGA1,DGDATE,DGDTE,DGT,DGTIME,XQOPT
- ;DG/582
- I $G(VALM("TITLE"))="Dependents Module" Q
- ;Lock global
- LOCK L +^DGSL(38.1,+DFN):1 G:'$T LOCK
- ;Add new entry for patient if not found
- I '$D(^DGSL(38.1,+DFN,0)) D
- .S ^DGSL(38.1,+DFN,0)=+DFN
- .S ^DGSL(38.1,"B",+DFN,+DFN)=""
- .S $P(^DGSL(38.1,0),U,3)=+DFN
- .S $P(^DGSL(38.1,0),U,4)=$P(^DGSL(38.1,0),U,4)+1
- .;Determine if entry is automatically sensitive
- .N ELIG,FLAG,X
- .S FLAG=0
- .S X=$S($D(^DPT(+DFN,"TYPE")):+^("TYPE"),1:"")
- .I $D(^DG(391,+X,0)),$P(^(0),"^",4) S FLAG=1
- .I 'FLAG S ELIG=0 F S ELIG=$O(^DPT(+DFN,"E",ELIG)) Q:'ELIG D Q:FLAG
- ..S X=$G(^DIC(8,ELIG,0))
- ..I $P(X,"^",12) S FLAG=1
- .S $P(^DGSL(38.1,+DFN,0),"^",2)=FLAG
- .;Date/time sensitivity was set
- .S $P(^DGSL(38.1,+DFN,0),"^",4)=$$NOW^XLFDT()
- ;determine if an inpatient
- D H^DGUTL
- S DGT=DGTIME
- I $G(DG1)="" D ^DGPMSTAT
- ;get option name
- I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
- SETUSR S DGDTE=9999999.9999-DGTIME I $D(^DGSL(38.1,+DFN,"D",DGDTE,0)) S DGTIME=DGTIME+.00001 G SETUSR
- S:'$D(^DGSL(38.1,+DFN,"D",0)) ^(0)="^38.11DA^^" S ^DGSL(38.1,+DFN,"D",DGDTE,0)=DGTIME_U_DGDUZ_U_$P(DGOPT,U,2)_U_$S(DG1:"y",1:"n"),$P(^(0),U,3,4)=DGDTE_U_($P(^DGSL(38.1,+DFN,"D",0),U,4)+1)
- S ^DGSL(38.1,"AD",DGDTE,+DFN)=""
- S ^DGSL(38.1,"AU",+DFN,DGDUZ,DGDTE)=""
- L -^DGSL(38.1,+DFN)
- ;
- I $$GET1^DIQ(46.5,1,.02,"I") D SELAUD^DGAUDIT2(2,$G(DFN),"INQUIRY",$G(DGOPT))
- ;
- Q
- Q K DG1,DGDATE,DGDTE,DGLNE,DGMSG,DGOPT,DGSEN,DGTIME,DGY,XQOPT
- N DGTEST S DGTEST=^%ZOSF("TEST")
- I DIC(0)["E",Y>0 D
- .S X="DGPFAPI" X DGTEST I $T D ;Patient Record Flags check/display
- ..N DGPFSAVY S DGPFSAVY=Y
- ..D DISPPRF^DGPFAPI(Y) S Y=DGPFSAVY K DGPFSAVY
- .S X="A7RDPACT" X DGTEST I $T D ^A7RDPACT ;NDBI
- .S X="GMRPNCW" X DGTEST I $T S DPTSAVY=Y D ENPAT^GMRPNCW S Y=DPTSAVY K DPTSAVY ; CWAD
- .S X="MPRCHK" X DGTEST I $T D EN^MPRCHK(Y) ; MPR
- Q
- ;
- BULTIN1(DFN,DGDUZ,DGOPT,DGMSG) ;Generate sensitive record access bulletin
- ;
- ;Input: DFN = Patient file IEN
- ; DGDUZ = New Person (#200) file IEN
- ; DGOPT = Option (#19) file Name (#.01)^Menu text
- ; DGMSG = Message array (Optional)
- ;
- N DGEMPLEE,XMSUB,XQOPT
- ;DG/582
- I $G(VALM("TITLE"))="Dependents Module" Q
- K DGB I $D(^DG(43,1,"NOT")),+$P(^("NOT"),U,10) S DGB=10
- Q:'$D(DGB) S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
- S DGB=+$P($G(^DG(43,1,"NOT")),U,DGB) Q:'DGB
- S DGB=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR") Q:'$L(DGB)
- ;S DGB=$P($G(^XMB(3.8,DGB,0)),U) Q:'$L(DGB)
- I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
- N XMB,XMY,XMY0,XMZ
- S XMB="DG SENSITIVITY",XMB(1)=$P(^DPT(+DFN,0),U)
- S DGEMPLEE=$$EMPL^DGSEC4(+DFN)
- I DGEMPLEE=1 S XMB(1)=XMB(1)_" (Employee)"
- S XMB(2)=$P(^DPT(+DFN,0),U,9),XMB(3)=$P(DGOPT,U,2),XMY("G."_DGB)=""
- N Y S Y=$$NOW^XLFDT() X ^DD("DD") S XMB(4)=Y
- D SEND(.XMB,.XMY)
- S DGMSG(1)="NOTE: A bulletin will now be sent to your station security officer."
- Q
- ;
- SEND(XMB,XMY) ;Queue mail bulletin
- ;Input: XMB,XMY=Mailman bulletin parameters
- ;
- D ^XMB
- Q
- ;
- DISP(ARRAY) ;Display message text to screen
- ;Input: Array containg message text
- ;
- I '$D(ARRAY) Q
- I DIC(0)'["E" Q
- I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY S X=0 X ^%ZOSF("RM")
- N DGI,DGWHERE
- I '$D(DDS) W !!
- F DGI=1:0 S DGI=$O(ARRAY(DGI)) Q:'DGI D
- .W ARRAY(DGI),!
- Q
- ;
- NOTCE1 W:'$D(DDS) ! W "Do you want to continue accessing this patient record" S %=2 D YN^DICN S:%<0!(%=2) Y=-1 I '% D W:'$D(DDS) !! W "Enter 'YES' to continue accessing, or 'NO' to quit accessing this record." W:$D(DDS) ! G NOTCE1
- .I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY
- Q
- ;
- LOADXMY() ;this adds the contents of field #509 of File #43 to the XMY array
- ;PDX plans to use this - remember to NEW DIC before ^XMD call
- ; Input - None
- ; Output - XMY("G.mailgroupname")="" if field #509 is defined
- ; where mailgroupname is text value of mail group
- ; Returns: 0 - Ok
- ; -1^errortext - if can't find mail group
- ;
- N DGB,DGERR,DGM
- S DGERR=0
- S DGB=+$P($G(^DG(43,1,"NOT")),"^",10)
- S DGM=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR")
- I '$D(DGM) S DGERR="-1^No/Bad Field #509 entry in File #43" G QTLOADX
- S XMY("G."_DGM)="" ; pass mailgroup
- QTLOADX Q DGERR
- ;
- DISP2V ;Display message text to screen for Vista
- N DGLNE
- S DGSENS(1)=1
- S DGSENS(2)=" ***WARNING*** "
- S DGSENS(3)=" ***RESTRICTED RECORD*** "
- S $P(DGLNE,"* ",40)=""
- S DGSENS(4)=DGLNE
- S DGSENS(5)="* 1. STOP *"
- S DGSENS(6)="* 2. Confirm you need access to this Restricted patient record *"
- S DGSENS(7)="* *"
- S DGSENS(8)="* This record is protected by the Privacy Act of 1974 and the Health *"
- S DGSENS(9)="* Insurance Portability and Accountability Act (HIPAA) Privacy Rule. *"
- S DGSENS(10)="* * Access to this patient record is tracked and monitored. *"
- S DGSENS(11)="* * You must have need for this record to accomplish officially *"
- S DGSENS(12)="* authorized and assigned duties, such as direct patient care, to *"
- S DGSENS(13)="* proceed. *"
- S DGSENS(14)="* * You must provide justification for your access upon request. *"
- S DGSENS(15)="* * Failure to comply may result in disciplinary or adverse action up to *"
- S DGSENS(16)="* and including removal from Federal service, and civil and criminal *"
- S DGSENS(17)="* penalties. *"
- I $G(DDS)="" S DGSENS(18)=DGLNE
- D DISP(.DGSENS)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGSEC 9221 printed Jan 18, 2025@03:59:33 Page 2
- DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 3/24/04 7:53pm
- +1 ;;5.3;Registration;**32,46,197,214,249,281,352,391,425,582,769,796,964,1130**;Aug 13, 1993;Build 7
- +2 ;Per VHA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;Entry point from DPTLK
- +5 IF +$GET(Y)=+$GET(^DISV(DUZ,"^DPT("))
- IF $GET(DPTBTDT)
- KILL DPTBTDT
- QUIT
- +6 NEW DFN,DGANS,DGMSG,DGOPT,DGPTSSN,DGREC,DGSENS,DGY,DX,DY,%,DG1
- +7 ;Y=Patient file DFN
- +8 SET DGY=Y
- +9 ;OWNREC^DGSEC4 parameters:
- +10 ; DGREC = output array passed by reference
- +11 ; DGY = Patient file DFN
- +12 ; DUZ = New Person file IEN
- +13 ; 1=generate error msg
- +14 ; DGNEWPT - set to 1 in DPTLK2 when adding new Patient (#2) file entry
- +15 ; DGPTSSN - set to patient's SSN when adding new Patient file entry
- +16 ; X=Patient's SSN from DPTLK2
- +17 IF $GET(DGNEWPT)=1
- SET DGPTSSN=X
- +18 DO OWNREC^DGSEC4(.DGREC,+DGY,DUZ,1,$GET(DGNEWPT),$GET(DGPTSSN))
- +19 SET Y=DGY
- +20 IF DGREC(1)=1!(DGREC(1)=2)
- Begin DoDot:1
- +21 SET Y=-1
- +22 DO DISP(.DGREC)
- +23 IF $DATA(DDS)
- READ !,"Please enter any key to continue.",DGANS:DTIME
- End DoDot:1
- GOTO Q
- +24 ;SENS^DGSEC4 parameters:
- +25 ; DGSENS = output array passed by reference
- +26 ; Y = Patient fileDFN
- +27 ; DUZ = New Person file IEN
- +28 ; DDS - Screenman variable
- +29 ; DGSENFLG - If defined, patient record sensitivity not checked
- +30 DO SENS^DGSEC4(.DGSENS,+Y,DUZ,$GET(DDS),.DGSENFLG)
- +31 ;DUZ must be defined to access a sensitive record
- +32 IF DGSENS(1)=-1
- Begin DoDot:1
- +33 SET Y=-1
- +34 DO DISP(.DGSENS)
- End DoDot:1
- GOTO Q
- +35 IF DGSENS(1)=0
- Begin DoDot:1
- +36 ;DG*5.3*964 hook to call VistA Security Remediation Audit solution VAS
- +37 IF $$GET1^DIQ(46.5,1,.02,"I")
- DO SELAUD^DGAUDIT2(2,$GET(DGY),"INQUIRY",$GET(DGOPT))
- End DoDot:1
- GOTO Q
- +38 ;Get option name for DG Security Log file and bulletin
- +39 DO OP^XQCHK
- SET DGOPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
- +40 IF DGSENS(1)=1
- Begin DoDot:1
- +41 IF DIC(0)["E"
- Begin DoDot:2
- +42 WRITE $CHAR(7)
- +43 DO DISP(.DGSENS)
- End DoDot:2
- +44 IF Y>0
- Begin DoDot:2
- +45 ;Parameters: DFN,DUZ,,Option name^Menu text
- +46 DO SETLOG1(+Y,DUZ,,DGOPT)
- End DoDot:2
- End DoDot:1
- +47 IF DGSENS(1)=2
- Begin DoDot:1
- +48 IF DIC(0)["E"
- Begin DoDot:2
- +49 WRITE $CHAR(7)
- +50 DO DISP2V
- +51 DO NOTCE1
- End DoDot:2
- +52 IF Y>0
- Begin DoDot:2
- +53 DO SETLOG1(+Y,DUZ,,DGOPT)
- +54 ;Parameters: DFN,DUZ,Option name^Menu text,message array
- +55 DO BULTIN1(+Y,DUZ,DGOPT,.DGMSG)
- +56 IF $DATA(DGSM)
- IF DIC(0)["E"
- DO DISP(.DGMSG)
- End DoDot:2
- End DoDot:1
- +57 DO Q
- +58 QUIT
- +59 ;
- REC ;DPTLK2 entry point when adding new Patient file record
- +1 ;Input: X=Patient's SSN
- +2 ;Output: DGREC=1 (adding own record or SSN not defined) or 0
- +3 ;
- +4 ;Parameters: DGREC=output array
- +5 ; DUZ
- +6 ; 1 - generate error msg
- +7 ; DGNEWPT = 1 (adding new Patient (#2) file record
- +8 ; DGPTSSN = X (Patient's SSN)
- +9 NEW DGPTSSN
- +10 SET DGPTSSN=X
- +11 DO OWNREC^DGSEC4(.DGREC,,DUZ,1,$GET(DGNEWPT),$GET(DGPTSSN))
- +12 IF DGREC(1)=1!(DGREC(1)=2)
- Begin DoDot:1
- +13 DO DISP(.DGREC)
- +14 IF $DATA(DDS)
- READ !,"Please enter any key to continue.",DGANS:DTIME
- End DoDot:1
- +15 SET DGREC=+DGREC(1)
- +16 IF DGREC=2
- SET DGREC=1
- +17 QUIT
- SETLOG ;Entry point for DBIA #2242
- +1 ;Input variables: Y=DFN,DUZ,DG1=Inpatient/outpatient indicator,DGOPT=Option name^Menu text
- +2 DO SETLOG1(Y,DUZ,DG1,DGOPT)
- +3 DO Q
- +4 QUIT
- BULTIN ;Entry point for DBIA #2242
- +1 ;Input variables: Y=DFN,DUZ,DGOPT=Option name^Menu text
- +2 DO BULTIN1(Y,DUZ,DGOPT)
- +3 QUIT
- SETLOG1(DFN,DGDUZ,DG1,DGOPT) ;Adds/updates entry in DG Security Log file (38.1)
- +1 ;Input:
- +2 ; DFN - Patient (#2) file DFN (Required)
- +3 ; DGDUZ - New Person (#200) file IEN
- +4 ; DG1 - Inpatient or Outpatient (Optional)
- +5 ; DGOPT - Option (#19) file Name (#.01)^Menu text (Optional)
- +6 ;
- +7 NEW DGA1,DGDATE,DGDTE,DGT,DGTIME,XQOPT
- +8 ;DG/582
- +9 IF $GET(VALM("TITLE"))="Dependents Module"
- QUIT
- +10 ;Lock global
- LOCK LOCK +^DGSL(38.1,+DFN):1
- if '$TEST
- GOTO LOCK
- +1 ;Add new entry for patient if not found
- +2 IF '$DATA(^DGSL(38.1,+DFN,0))
- Begin DoDot:1
- +3 SET ^DGSL(38.1,+DFN,0)=+DFN
- +4 SET ^DGSL(38.1,"B",+DFN,+DFN)=""
- +5 SET $PIECE(^DGSL(38.1,0),U,3)=+DFN
- +6 SET $PIECE(^DGSL(38.1,0),U,4)=$PIECE(^DGSL(38.1,0),U,4)+1
- +7 ;Determine if entry is automatically sensitive
- +8 NEW ELIG,FLAG,X
- +9 SET FLAG=0
- +10 SET X=$SELECT($DATA(^DPT(+DFN,"TYPE")):+^("TYPE"),1:"")
- +11 IF $DATA(^DG(391,+X,0))
- IF $PIECE(^(0),"^",4)
- SET FLAG=1
- +12 IF 'FLAG
- SET ELIG=0
- FOR
- SET ELIG=$ORDER(^DPT(+DFN,"E",ELIG))
- if 'ELIG
- QUIT
- Begin DoDot:2
- +13 SET X=$GET(^DIC(8,ELIG,0))
- +14 IF $PIECE(X,"^",12)
- SET FLAG=1
- End DoDot:2
- if FLAG
- QUIT
- +15 SET $PIECE(^DGSL(38.1,+DFN,0),"^",2)=FLAG
- +16 ;Date/time sensitivity was set
- +17 SET $PIECE(^DGSL(38.1,+DFN,0),"^",4)=$$NOW^XLFDT()
- End DoDot:1
- +18 ;determine if an inpatient
- +19 DO H^DGUTL
- +20 SET DGT=DGTIME
- +21 IF $GET(DG1)=""
- DO ^DGPMSTAT
- +22 ;get option name
- +23 IF $GET(DGOPT)=""
- DO OP^XQCHK
- SET DGOPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
- SETUSR SET DGDTE=9999999.9999-DGTIME
- IF $DATA(^DGSL(38.1,+DFN,"D",DGDTE,0))
- SET DGTIME=DGTIME+.00001
- GOTO SETUSR
- +1 if '$DATA(^DGSL(38.1,+DFN,"D",0))
- SET ^(0)="^38.11DA^^"
- SET ^DGSL(38.1,+DFN,"D",DGDTE,0)=DGTIME_U_DGDUZ_U_$PIECE(DGOPT,U,2)_U_$SELECT(DG1:"y",1:"n")
- SET $PIECE(^(0),U,3,4)=DGDTE_U_($PIECE(^DGSL(38.1,+DFN,"D",0),U,4)+1)
- +2 SET ^DGSL(38.1,"AD",DGDTE,+DFN)=""
- +3 SET ^DGSL(38.1,"AU",+DFN,DGDUZ,DGDTE)=""
- +4 LOCK -^DGSL(38.1,+DFN)
- +5 ;
- +6 IF $$GET1^DIQ(46.5,1,.02,"I")
- DO SELAUD^DGAUDIT2(2,$GET(DFN),"INQUIRY",$GET(DGOPT))
- +7 ;
- +8 QUIT
- Q KILL DG1,DGDATE,DGDTE,DGLNE,DGMSG,DGOPT,DGSEN,DGTIME,DGY,XQOPT
- +1 NEW DGTEST
- SET DGTEST=^%ZOSF("TEST")
- +2 IF DIC(0)["E"
- IF Y>0
- Begin DoDot:1
- +3 ;Patient Record Flags check/display
- SET X="DGPFAPI"
- XECUTE DGTEST
- IF $TEST
- Begin DoDot:2
- +4 NEW DGPFSAVY
- SET DGPFSAVY=Y
- +5 DO DISPPRF^DGPFAPI(Y)
- SET Y=DGPFSAVY
- KILL DGPFSAVY
- End DoDot:2
- +6 ;NDBI
- SET X="A7RDPACT"
- XECUTE DGTEST
- IF $TEST
- DO ^A7RDPACT
- +7 ; CWAD
- SET X="GMRPNCW"
- XECUTE DGTEST
- IF $TEST
- SET DPTSAVY=Y
- DO ENPAT^GMRPNCW
- SET Y=DPTSAVY
- KILL DPTSAVY
- +8 ; MPR
- SET X="MPRCHK"
- XECUTE DGTEST
- IF $TEST
- DO EN^MPRCHK(Y)
- End DoDot:1
- +9 QUIT
- +10 ;
- BULTIN1(DFN,DGDUZ,DGOPT,DGMSG) ;Generate sensitive record access bulletin
- +1 ;
- +2 ;Input: DFN = Patient file IEN
- +3 ; DGDUZ = New Person (#200) file IEN
- +4 ; DGOPT = Option (#19) file Name (#.01)^Menu text
- +5 ; DGMSG = Message array (Optional)
- +6 ;
- +7 NEW DGEMPLEE,XMSUB,XQOPT
- +8 ;DG/582
- +9 IF $GET(VALM("TITLE"))="Dependents Module"
- QUIT
- +10 KILL DGB
- IF $DATA(^DG(43,1,"NOT"))
- IF +$PIECE(^("NOT"),U,10)
- SET DGB=10
- +11 if '$DATA(DGB)
- QUIT
- SET XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
- +12 SET DGB=+$PIECE($GET(^DG(43,1,"NOT")),U,DGB)
- if 'DGB
- QUIT
- +13 SET DGB=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR")
- if '$LENGTH(DGB)
- QUIT
- +14 ;S DGB=$P($G(^XMB(3.8,DGB,0)),U) Q:'$L(DGB)
- +15 IF $GET(DGOPT)=""
- DO OP^XQCHK
- SET DGOPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
- +16 NEW XMB,XMY,XMY0,XMZ
- +17 SET XMB="DG SENSITIVITY"
- SET XMB(1)=$PIECE(^DPT(+DFN,0),U)
- +18 SET DGEMPLEE=$$EMPL^DGSEC4(+DFN)
- +19 IF DGEMPLEE=1
- SET XMB(1)=XMB(1)_" (Employee)"
- +20 SET XMB(2)=$PIECE(^DPT(+DFN,0),U,9)
- SET XMB(3)=$PIECE(DGOPT,U,2)
- SET XMY("G."_DGB)=""
- +21 NEW Y
- SET Y=$$NOW^XLFDT()
- XECUTE ^DD("DD")
- SET XMB(4)=Y
- +22 DO SEND(.XMB,.XMY)
- +23 SET DGMSG(1)="NOTE: A bulletin will now be sent to your station security officer."
- +24 QUIT
- +25 ;
- SEND(XMB,XMY) ;Queue mail bulletin
- +1 ;Input: XMB,XMY=Mailman bulletin parameters
- +2 ;
- +3 DO ^XMB
- +4 QUIT
- +5 ;
- DISP(ARRAY) ;Display message text to screen
- +1 ;Input: Array containg message text
- +2 ;
- +3 IF '$DATA(ARRAY)
- QUIT
- +4 IF DIC(0)'["E"
- QUIT
- +5 IF $DATA(DDS)
- DO CLRMSG^DDS
- SET DX=0
- SET DY=DDSHBX+1
- XECUTE DDXY
- SET X=0
- XECUTE ^%ZOSF("RM")
- +6 NEW DGI,DGWHERE
- +7 IF '$DATA(DDS)
- WRITE !!
- +8 FOR DGI=1:0
- SET DGI=$ORDER(ARRAY(DGI))
- if 'DGI
- QUIT
- Begin DoDot:1
- +9 WRITE ARRAY(DGI),!
- End DoDot:1
- +10 QUIT
- +11 ;
- NOTCE1 if '$DATA(DDS)
- WRITE !
- WRITE "Do you want to continue accessing this patient record"
- SET %=2
- DO YN^DICN
- if %<0!(%=2)
- SET Y=-1
- IF '%
- Begin DoDot:1
- +1 IF $DATA(DDS)
- DO CLRMSG^DDS
- SET DX=0
- SET DY=DDSHBX+1
- XECUTE DDXY
- End DoDot:1
- if '$DATA(DDS)
- WRITE !!
- WRITE "Enter 'YES' to continue accessing, or 'NO' to quit accessing this record."
- if $DATA(DDS)
- WRITE !
- GOTO NOTCE1
- +2 QUIT
- +3 ;
- LOADXMY() ;this adds the contents of field #509 of File #43 to the XMY array
- +1 ;PDX plans to use this - remember to NEW DIC before ^XMD call
- +2 ; Input - None
- +3 ; Output - XMY("G.mailgroupname")="" if field #509 is defined
- +4 ; where mailgroupname is text value of mail group
- +5 ; Returns: 0 - Ok
- +6 ; -1^errortext - if can't find mail group
- +7 ;
- +8 NEW DGB,DGERR,DGM
- +9 SET DGERR=0
- +10 SET DGB=+$PIECE($GET(^DG(43,1,"NOT")),"^",10)
- +11 SET DGM=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR")
- +12 IF '$DATA(DGM)
- SET DGERR="-1^No/Bad Field #509 entry in File #43"
- GOTO QTLOADX
- +13 ; pass mailgroup
- SET XMY("G."_DGM)=""
- QTLOADX QUIT DGERR
- +1 ;
- DISP2V ;Display message text to screen for Vista
- +1 NEW DGLNE
- +2 SET DGSENS(1)=1
- +3 SET DGSENS(2)=" ***WARNING*** "
- +4 SET DGSENS(3)=" ***RESTRICTED RECORD*** "
- +5 SET $PIECE(DGLNE,"* ",40)=""
- +6 SET DGSENS(4)=DGLNE
- +7 SET DGSENS(5)="* 1. STOP *"
- +8 SET DGSENS(6)="* 2. Confirm you need access to this Restricted patient record *"
- +9 SET DGSENS(7)="* *"
- +10 SET DGSENS(8)="* This record is protected by the Privacy Act of 1974 and the Health *"
- +11 SET DGSENS(9)="* Insurance Portability and Accountability Act (HIPAA) Privacy Rule. *"
- +12 SET DGSENS(10)="* * Access to this patient record is tracked and monitored. *"
- +13 SET DGSENS(11)="* * You must have need for this record to accomplish officially *"
- +14 SET DGSENS(12)="* authorized and assigned duties, such as direct patient care, to *"
- +15 SET DGSENS(13)="* proceed. *"
- +16 SET DGSENS(14)="* * You must provide justification for your access upon request. *"
- +17 SET DGSENS(15)="* * Failure to comply may result in disciplinary or adverse action up to *"
- +18 SET DGSENS(16)="* and including removal from Federal service, and civil and criminal *"
- +19 SET DGSENS(17)="* penalties. *"
- +20 IF $GET(DDS)=""
- SET DGSENS(18)=DGLNE
- +21 DO DISP(.DGSENS)
- +22 QUIT