198 lines
6.9 KiB
Mathematica
198 lines
6.9 KiB
Mathematica
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**;Aug 13, 1993
|
|
;
|
|
;Entry point from DPTLK
|
|
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 G Q
|
|
;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 DISP(.DGSENS)
|
|
..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)
|
|
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=$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
|
|
.S DGWHERE=(80-$L(ARRAY(DGI)))\2
|
|
.W ?DGWHERE,ARRAY(DGI),!
|
|
Q
|
|
;
|
|
NOTCE1 W:'$D(DDS) !! W "Do you want to continue processing this patient record" S %=2 D YN^DICN S:%<0!(%=2) Y=-1 I '% D W:'$D(DDS) !! W "Enter 'YES' to continue processing, or 'NO' to quit processing 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
|
|
S DGERR=0
|
|
S DGB=+$P($G(^DG(43,1,"NOT")),"^",10)
|
|
I '$D(^XMB(3.8,DGB,0))#2 S DGERR="-1^No/Bad Field #509 entry in File #43" G QTLOADX
|
|
S XMY("G."_$P($G(^XMB(3.8,DGB,0)),"^",1))="" ; pass mailgroup
|
|
QTLOADX Q DGERR
|