BDGSPT2 ; IHS/OIT/LJF - LIST TEMPLATE CODE FOR USER ACCESS RESTRICTIONS
;;5.3;PIMS;**1008,1009**;MAY 28, 2004
;IHS/OIT/LJF 08/23/2007 ROUTINE ADDED with Patch 1008
;
USER ;EP; Select User whose access will be restricted
; called by option BDG SECURITY RESTRICTIONS
NEW BDGUSR,SCREEN,HELP
;restrict person from accessing their own user record
S SCREEN="I (+Y'=DUZ),($P(^VA(200,+Y,0),U,11)=""""),($P(^VA(200,+Y,0),U,3)]"""")"
S HELP="Select an active user. Cannot select yourself."
S BDGUSR=+$$READ^BDGF("PO^200:EMQZ","Select USER",,HELP,SCREEN) Q:BDGUSR<1
D EN,USER
Q
;
EN ;EP; -- main entry point for BDG SECURITY RESTRICTIONS list template
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG SECURITY RESTRICTIONS")
D CLEAR^VALM1
Q
;
HDR ; -- header code
NEW X
S X=$$GET1^DIQ(200,+$G(BDGUSR),.01)
S VALMHDR(1)=$$PAD("User:",12)_X_$$SP(7)_$$GET1^DIQ(200,+$G(BDGUSR),8)
S VALMHDR(2)=$$SP(12)_"Last Signed on "_$$GET1^DIQ(200,+$G(BDGUSR),202)
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BDGSPT2",$J),^TMP("BDGSPT2A",$J)
;
; find entries and sort by status and then by patient name
NEW STATUS,DFN,PATNM,SORT
S DFN=0 F S DFN=$O(^BDGSPT(BDGUSR,1,DFN)) Q:'DFN D
. S PATNM=$$GET1^DIQ(2,DFN,.01)
. S STATUS=$$STATUS(BDGUSR,DFN,2) ;2=long format
. S SORT=$S(STATUS["RESTRICTED":1,STATUS["TEMPORARY":2,1:3)
. S ^TMP("BDGSPT2A",$J,SORT,PATNM,DFN)=STATUS
;
; now take sorted list and create display array
S COUNT=0
S SORT=0 F S SORT=$O(^TMP("BDGSPT2A",$J,SORT)) Q:'SORT D
. I VALMCNT>0 D SET("",.VALMCNT,$G(COUNT),0)
. S PATNM=0 F S PATNM=$O(^TMP("BDGSPT2A",$J,SORT,PATNM)) Q:PATNM="" D
. . S DFN=0 F S DFN=$O(^TMP("BDGSPT2A",$J,SORT,PATNM,DFN)) Q:'DFN D
. . . S COUNT=COUNT+1
. . . S LINE=$$PAD($J(COUNT,3)_$$SP(3)_$E(PATNM,1,25),33)
. . . S LINE=$$PAD(LINE_$J($$HRCN^BDGF2(DFN,DUZ(2)),6),43)
. . . S LINE=LINE_^TMP("BDGSPT2A",$J,SORT,PATNM,DFN)
. . . D SET(LINE,.VALMCNT,COUNT,DFN)
;
I '$D(^TMP("BDGSPT2",$J)) S VALMCNT=1,^TMP("BDGSPT2",$J,1,0)=$$SP(15)_"NO RESTRICTED RECORDS FOUND"
K ^TMP("BDGSPT2A",$J)
Q
;
SET(LINE,NUM,COUNT,IEN) ; put display line into array
S NUM=NUM+1
S ^TMP("BDGSPT2",$J,NUM,0)=LINE
S ^TMP("BDGSPT2",$J,"IDX",NUM,COUNT)=IEN
Q
;
ADD ;EP; called by BDG RESTRICTED ADD protocol
D FULL^VALM1
I '$D(^BDGSPT(BDGUSR)) D ADDUSER
I '$D(^BDGSPT(BDGUSR)) D Q
. W !!,"PROBLEM ADDING USER TO FILE - CONTACT IT DEPARTMENT"
. S VALMBCK="R"
. D PAUSE^BDGF
;
S DA(1)=BDGUSR,DIC="^BDGSPT("_DA(1)_",1,",DIC(0)="AEMQLZ",DLAYGO=9009018.11
S DIC("P")=$P(^DD(9009018.1,1,0),U,2)
S DIC("DR")=".02///"_$$NOW^XLFDT_";.03///`"_DUZ
D ^DIC
D RESET
Q
;
LIFT ;EP; called by BDG RESTRICTED LIFT protocol
D FULL^VALM1
NEW DATE,DFN
D GETPAT Q:'$G(DFN)
;
; code if restriction already lifted
S DATE=$O(^BDGSPT(BDGUSR,1,DFN,1,"A"),-1)
I DATE,$P($G(^BDGSPT(BDGUSR,1,DFN,1,DATE,0)),U,4)="" D D RESET Q
. W !!,$$STATUS(BDGUSR,DFN,2)
. Q:'$$READ^BDGF("Y","Do You Want to Change the EFFECTIVE DATE","NO")
. NEW DIE,DA,DR
. S DIE="^BDGSPT("_BDGUSR_",1,"_DFN_",1,",DA=DATE,DA(1)=DFN,DA(2)=BDGUSR
. S DR=".03R;.07///"_$$NOW^XLFDT_";.08///`"_DUZ
. D ^DIE
;
; and if new restriction being added
NEW DIC,DA,X,Y
S DIC="^BDGSPT("_BDGUSR_",1,"_DFN_",1,",DIC(0)="L",DLAYGO=9009018.111
S DIC("P")=$P(^DD(9009018.11,1,0),U,2)
S X=$$NOW^XLFDT,DA(1)=DFN,DA(2)=BDGUSR
S DIC("DR")=".02///`"_DUZ_";.03R"
D ^DIC
D RESET
Q
;
RESUME ;EP; called by BDG RESTRICTED RESUME protocol
D FULL^VALM1
NEW DATE,DFN
D GETPAT Q:'$G(DFN)
;
S DATE=$O(^BDGSPT(BDGUSR,1,DFN,1,"A"),-1)
I 'DATE D Q
. W !!,"ACCESS CURRENTLY RESTRICTED; NOTHING TO RESUME"
. D PAUSE^BDGF,RESET
;
NEW X,QUIT
S X=$$GET1^DIQ(9009018.111,DATE_","_DFN_","_BDGUSR,.04) I X]"" D I $G(QUIT) D RESET Q
. W !!,"RESTRICTION LAST RESUMED ON "_X
. I '$$READ^BDGF("Y","Do You Want to Edit the Last RESUME DATE","NO") S QUIT=1
;
; enter or edit resume date
NEW DIE,DA,DR,X,Y
S DIE="^BDGSPT("_BDGUSR_",1,"_DFN_",1,"
S DA=DATE,DA(1)=DFN,DA(2)=BDGUSR
S DR=".04;.05///"_$$NOW^XLFDT_";.06///`"_DUZ
D ^DIE
D RESET
Q
;
VIEW ;EP; called by BDG RESTRICTED VIEW protocol
D FULL^VALM1
NEW DFN
D GETPAT Q:'$G(DFN)
;
D EN^BDGSPT3
S VALMBCK="R"
Q
;
ADDUSER ; adds user to file if not already there
NEW DIC,DLAYGO,X,Y
S (DIC,DLAYGO)=9009018.1,DIC(0)="L",X="`"_BDGUSR D ^DIC
Q
;
GETPAT ; -- select patient from listing
NEW X,Y,Z,BDGPAT
D FULL^VALM1
S BDGPAT=""
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) Q
S X=$O(VALMY(0))
S Y=0 F S Y=$O(^TMP("BDGSPT2",$J,"IDX",Y)) Q:Y="" Q:BDGPAT]"" D
. S Z=$O(^TMP("BDGSPT2",$J,"IDX",Y,0))
. Q:^TMP("BDGSPT2",$J,"IDX",Y,Z)=""
. I Z=X S BDGPAT=^TMP("BDGSPT2",$J,"IDX",Y,Z)
S DFN=BDGPAT
Q
;
RESET ;EP; return from protocol & rebuild list
S VALMBCK="R" D TERM^VALM0,HDR,INIT Q
;
HELP ;EP -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;EP -- exit code
K ^TMP("BDGSPT2",$J)
Q
;
EXPND ;EP -- expand code
Q
;
;
PAD(D,L) ; -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
;
STATUS(USR,PAT,MODE) ;EP; returns restriction status for user/patient pair
; called by this routine and computed field STATUS
; also called by ^DGSEC to determine access for user to this patient
; If MODE=1, then return short format (default)
; If MODE=2, then return long format
I ('$G(USR))!('$G(PAT)) Q "UNKNOWN"
I '$D(^BDGSPT(USR,1,PAT)) Q "ACCESS ALLOWED"
I '$O(^BDGSPT(USR,1,PAT,0)) Q "RESTRICTED ACCESS"
;
; find last restriction lifted edit date
NEW DATE,END
S DATE=$O(^BDGSPT(USR,1,PAT,1,"A"),-1)
I 'DATE Q "RESTRICTED ACCESS"
I $P(^BDGSPT(USR,1,PAT,1,DATE,0),U,3)>$$NOW^XLFDT Q "RESTRICTED ACCESS UNTIL "_$$GET1^DIQ(9009018.111,DATE_","_PAT_","_USR,.03)
S END=$P(^BDGSPT(USR,1,PAT,1,DATE,0),U,4)
I END="" Q "ACCESS REINSTATED"_$S($G(MODE)=2:" on "_$$GET1^DIQ(9009018.111,DATE_","_PAT_","_USR,.03),1:"")
I END>DT Q "TEMPORARY ACCESS"_$S(MODE=2:" until "_$$GET1^DIQ(9009018.111,DATE_","_PAT_","_USR,.04),1:"")
Q "RESTRICTED ACCESS"
;
LIFTCHK(USER,DFN,DTIEN,LIFT) ;EP; called by input transform
; make sure date restriction lifted is not before first restriction
; AND not before last time restriction resumed
I LIFT<($P(^BDGSPT(USER,1,DFN,0),U,2)\1) Q 0 ;check against first restriction
NEW LAST S LAST=$O(^BDGSPT(USER,1,DFN,1,DTIEN),-1)
I (LAST),(LIFT<$P(^BDGSPT(USER,1,DFN,1,LAST,0),U,4)) Q 0 ;check aginst last resumption
Q 1
;
RESUMCHK(USER,DFN,DTIEN,RESUME) ;EP; called by input transform
; Make sure date restriction resumes is not before date lifted
I RESUME<$P(^BDGSPT(USER,1,DFN,1,DTIEN,0),U,3) Q 0
Q 1
BDGSPT2 ; IHS/OIT/LJF - LIST TEMPLATE CODE FOR USER ACCESS RESTRICTIONS
+1 ;;5.3;PIMS;**1008,1009**;MAY 28, 2004
+2 ;IHS/OIT/LJF 08/23/2007 ROUTINE ADDED with Patch 1008
+3 ;
USER ;EP; Select User whose access will be restricted
+1 ; called by option BDG SECURITY RESTRICTIONS
+2 NEW BDGUSR,SCREEN,HELP
+3 ;restrict person from accessing their own user record
+4 SET SCREEN="I (+Y'=DUZ),($P(^VA(200,+Y,0),U,11)=""""),($P(^VA(200,+Y,0),U,3)]"""")"
+5 SET HELP="Select an active user. Cannot select yourself."
+6 SET BDGUSR=+$$READ^BDGF("PO^200:EMQZ","Select USER",,HELP,SCREEN)
IF BDGUSR<1
QUIT
+7 DO EN
DO USER
+8 QUIT
+9 ;
EN ;EP; -- main entry point for BDG SECURITY RESTRICTIONS list template
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO EN^VALM("BDG SECURITY RESTRICTIONS")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ; -- header code
+1 NEW X
+2 SET X=$$GET1^DIQ(200,+$GET(BDGUSR),.01)
+3 SET VALMHDR(1)=$$PAD("User:",12)_X_$$SP(7)_$$GET1^DIQ(200,+$GET(BDGUSR),8)
+4 SET VALMHDR(2)=$$SP(12)_"Last Signed on "_$$GET1^DIQ(200,+$GET(BDGUSR),202)
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 SET VALMCNT=0
KILL ^TMP("BDGSPT2",$JOB),^TMP("BDGSPT2A",$JOB)
+2 ;
+3 ; find entries and sort by status and then by patient name
+4 NEW STATUS,DFN,PATNM,SORT
+5 SET DFN=0
FOR
SET DFN=$ORDER(^BDGSPT(BDGUSR,1,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+6 SET PATNM=$$GET1^DIQ(2,DFN,.01)
+7 ;2=long format
SET STATUS=$$STATUS(BDGUSR,DFN,2)
+8 SET SORT=$SELECT(STATUS["RESTRICTED":1,STATUS["TEMPORARY":2,1:3)
+9 SET ^TMP("BDGSPT2A",$JOB,SORT,PATNM,DFN)=STATUS
End DoDot:1
+10 ;
+11 ; now take sorted list and create display array
+12 SET COUNT=0
+13 SET SORT=0
FOR
SET SORT=$ORDER(^TMP("BDGSPT2A",$JOB,SORT))
IF 'SORT
QUIT
Begin DoDot:1
+14 IF VALMCNT>0
DO SET("",.VALMCNT,$GET(COUNT),0)
+15 SET PATNM=0
FOR
SET PATNM=$ORDER(^TMP("BDGSPT2A",$JOB,SORT,PATNM))
IF PATNM=""
QUIT
Begin DoDot:2
+16 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("BDGSPT2A",$JOB,SORT,PATNM,DFN))
IF 'DFN
QUIT
Begin DoDot:3
+17 SET COUNT=COUNT+1
+18 SET LINE=$$PAD($JUSTIFY(COUNT,3)_$$SP(3)_$EXTRACT(PATNM,1,25),33)
+19 SET LINE=$$PAD(LINE_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6),43)
+20 SET LINE=LINE_^TMP("BDGSPT2A",$JOB,SORT,PATNM,DFN)
+21 DO SET(LINE,.VALMCNT,COUNT,DFN)
End DoDot:3
End DoDot:2
End DoDot:1
+22 ;
+23 IF '$DATA(^TMP("BDGSPT2",$JOB))
SET VALMCNT=1
SET ^TMP("BDGSPT2",$JOB,1,0)=$$SP(15)_"NO RESTRICTED RECORDS FOUND"
+24 KILL ^TMP("BDGSPT2A",$JOB)
+25 QUIT
+26 ;
SET(LINE,NUM,COUNT,IEN) ; put display line into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGSPT2",$JOB,NUM,0)=LINE
+3 SET ^TMP("BDGSPT2",$JOB,"IDX",NUM,COUNT)=IEN
+4 QUIT
+5 ;
ADD ;EP; called by BDG RESTRICTED ADD protocol
+1 DO FULL^VALM1
+2 IF '$DATA(^BDGSPT(BDGUSR))
DO ADDUSER
+3 IF '$DATA(^BDGSPT(BDGUSR))
Begin DoDot:1
+4 WRITE !!,"PROBLEM ADDING USER TO FILE - CONTACT IT DEPARTMENT"
+5 SET VALMBCK="R"
+6 DO PAUSE^BDGF
End DoDot:1
QUIT
+7 ;
+8 SET DA(1)=BDGUSR
SET DIC="^BDGSPT("_DA(1)_",1,"
SET DIC(0)="AEMQLZ"
SET DLAYGO=9009018.11
+9 SET DIC("P")=$PIECE(^DD(9009018.1,1,0),U,2)
+10 SET DIC("DR")=".02///"_$$NOW^XLFDT_";.03///`"_DUZ
+11 DO ^DIC
+12 DO RESET
+13 QUIT
+14 ;
LIFT ;EP; called by BDG RESTRICTED LIFT protocol
+1 DO FULL^VALM1
+2 NEW DATE,DFN
+3 DO GETPAT
IF '$GET(DFN)
QUIT
+4 ;
+5 ; code if restriction already lifted
+6 SET DATE=$ORDER(^BDGSPT(BDGUSR,1,DFN,1,"A"),-1)
+7 IF DATE
IF $PIECE($GET(^BDGSPT(BDGUSR,1,DFN,1,DATE,0)),U,4)=""
Begin DoDot:1
+8 WRITE !!,$$STATUS(BDGUSR,DFN,2)
+9 IF '$$READ^BDGF("Y","Do You Want to Change the EFFECTIVE DATE","NO")
QUIT
+10 NEW DIE,DA,DR
+11 SET DIE="^BDGSPT("_BDGUSR_",1,"_DFN_",1,"
SET DA=DATE
SET DA(1)=DFN
SET DA(2)=BDGUSR
+12 SET DR=".03R;.07///"_$$NOW^XLFDT_";.08///`"_DUZ
+13 DO ^DIE
End DoDot:1
DO RESET
QUIT
+14 ;
+15 ; and if new restriction being added
+16 NEW DIC,DA,X,Y
+17 SET DIC="^BDGSPT("_BDGUSR_",1,"_DFN_",1,"
SET DIC(0)="L"
SET DLAYGO=9009018.111
+18 SET DIC("P")=$PIECE(^DD(9009018.11,1,0),U,2)
+19 SET X=$$NOW^XLFDT
SET DA(1)=DFN
SET DA(2)=BDGUSR
+20 SET DIC("DR")=".02///`"_DUZ_";.03R"
+21 DO ^DIC
+22 DO RESET
+23 QUIT
+24 ;
RESUME ;EP; called by BDG RESTRICTED RESUME protocol
+1 DO FULL^VALM1
+2 NEW DATE,DFN
+3 DO GETPAT
IF '$GET(DFN)
QUIT
+4 ;
+5 SET DATE=$ORDER(^BDGSPT(BDGUSR,1,DFN,1,"A"),-1)
+6 IF 'DATE
Begin DoDot:1
+7 WRITE !!,"ACCESS CURRENTLY RESTRICTED; NOTHING TO RESUME"
+8 DO PAUSE^BDGF
DO RESET
End DoDot:1
QUIT
+9 ;
+10 NEW X,QUIT
+11 SET X=$$GET1^DIQ(9009018.111,DATE_","_DFN_","_BDGUSR,.04)
IF X]""
Begin DoDot:1
+12 WRITE !!,"RESTRICTION LAST RESUMED ON "_X
+13 IF '$$READ^BDGF("Y","Do You Want to Edit the Last RESUME DATE","NO")
SET QUIT=1
End DoDot:1
IF $GET(QUIT)
DO RESET
QUIT
+14 ;
+15 ; enter or edit resume date
+16 NEW DIE,DA,DR,X,Y
+17 SET DIE="^BDGSPT("_BDGUSR_",1,"_DFN_",1,"
+18 SET DA=DATE
SET DA(1)=DFN
SET DA(2)=BDGUSR
+19 SET DR=".04;.05///"_$$NOW^XLFDT_";.06///`"_DUZ
+20 DO ^DIE
+21 DO RESET
+22 QUIT
+23 ;
VIEW ;EP; called by BDG RESTRICTED VIEW protocol
+1 DO FULL^VALM1
+2 NEW DFN
+3 DO GETPAT
IF '$GET(DFN)
QUIT
+4 ;
+5 DO EN^BDGSPT3
+6 SET VALMBCK="R"
+7 QUIT
+8 ;
ADDUSER ; adds user to file if not already there
+1 NEW DIC,DLAYGO,X,Y
+2 SET (DIC,DLAYGO)=9009018.1
SET DIC(0)="L"
SET X="`"_BDGUSR
DO ^DIC
+3 QUIT
+4 ;
GETPAT ; -- select patient from listing
+1 NEW X,Y,Z,BDGPAT
+2 DO FULL^VALM1
+3 SET BDGPAT=""
+4 DO EN^VALM2(XQORNOD(0),"OS")
+5 IF '$DATA(VALMY)
QUIT
+6 SET X=$ORDER(VALMY(0))
+7 SET Y=0
FOR
SET Y=$ORDER(^TMP("BDGSPT2",$JOB,"IDX",Y))
IF Y=""
QUIT
IF BDGPAT]""
QUIT
Begin DoDot:1
+8 SET Z=$ORDER(^TMP("BDGSPT2",$JOB,"IDX",Y,0))
+9 IF ^TMP("BDGSPT2",$JOB,"IDX",Y,Z)=""
QUIT
+10 IF Z=X
SET BDGPAT=^TMP("BDGSPT2",$JOB,"IDX",Y,Z)
End DoDot:1
+11 SET DFN=BDGPAT
+12 QUIT
+13 ;
RESET ;EP; return from protocol & rebuild list
+1 SET VALMBCK="R"
DO TERM^VALM0
DO HDR
DO INIT
QUIT
+2 ;
HELP ;EP -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ;EP -- exit code
+1 KILL ^TMP("BDGSPT2",$JOB)
+2 QUIT
+3 ;
EXPND ;EP -- expand code
+1 QUIT
+2 ;
+3 ;
PAD(D,L) ; -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
+2 ;
STATUS(USR,PAT,MODE) ;EP; returns restriction status for user/patient pair
+1 ; called by this routine and computed field STATUS
+2 ; also called by ^DGSEC to determine access for user to this patient
+3 ; If MODE=1, then return short format (default)
+4 ; If MODE=2, then return long format
+5 IF ('$GET(USR))!('$GET(PAT))
QUIT "UNKNOWN"
+6 IF '$DATA(^BDGSPT(USR,1,PAT))
QUIT "ACCESS ALLOWED"
+7 IF '$ORDER(^BDGSPT(USR,1,PAT,0))
QUIT "RESTRICTED ACCESS"
+8 ;
+9 ; find last restriction lifted edit date
+10 NEW DATE,END
+11 SET DATE=$ORDER(^BDGSPT(USR,1,PAT,1,"A"),-1)
+12 IF 'DATE
QUIT "RESTRICTED ACCESS"
+13 IF $PIECE(^BDGSPT(USR,1,PAT,1,DATE,0),U,3)>$$NOW^XLFDT
QUIT "RESTRICTED ACCESS UNTIL "_$$GET1^DIQ(9009018.111,DATE_","_PAT_","_USR,.03)
+14 SET END=$PIECE(^BDGSPT(USR,1,PAT,1,DATE,0),U,4)
+15 IF END=""
QUIT "ACCESS REINSTATED"_$SELECT($GET(MODE)=2:" on "_$$GET1^DIQ(9009018.111,DATE_","_PAT_","_USR,.03),1:"")
+16 IF END>DT
QUIT "TEMPORARY ACCESS"_$SELECT(MODE=2:" until "_$$GET1^DIQ(9009018.111,DATE_","_PAT_","_USR,.04),1:"")
+17 QUIT "RESTRICTED ACCESS"
+18 ;
LIFTCHK(USER,DFN,DTIEN,LIFT) ;EP; called by input transform
+1 ; make sure date restriction lifted is not before first restriction
+2 ; AND not before last time restriction resumed
+3 ;check against first restriction
IF LIFT<($PIECE(^BDGSPT(USER,1,DFN,0),U,2)\1)
QUIT 0
+4 NEW LAST
SET LAST=$ORDER(^BDGSPT(USER,1,DFN,1,DTIEN),-1)
+5 ;check aginst last resumption
IF (LAST)
IF (LIFT<$PIECE(^BDGSPT(USER,1,DFN,1,LAST,0),U,4))
QUIT 0
+6 QUIT 1
+7 ;
RESUMCHK(USER,DFN,DTIEN,RESUME) ;EP; called by input transform
+1 ; Make sure date restriction resumes is not before date lifted
+2 IF RESUME<$PIECE(^BDGSPT(USER,1,DFN,1,DTIEN,0),U,3)
QUIT 0
+3 QUIT 1
