- PSBVDLTB ;BIRMINGHAM/EFC-BCMA VIRTUAL DUE LIST FUNCTIONS (CONT) ;03/06/16 3:06pm
- ;;3.0;BAR CODE MED ADMIN;**3,4,16,68,70,78,83,92,147**;Mar 2004;Build 1
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- ; Reference/IA
- ; EN^PSJBCMA/2828
- ; IN5^VADPT/10061
- ; DEM^VADPT/10061
- ; INP^VADPT/10061
- ; $$FMADD^XLFDT/10103
- ; $$GET^XPAR/2263
- ;
- ;*68 - add new parameter to use new SI/OPI word processing fields
- ;*70 - add Clinic order request IN param flag (true/false 0/1).
- ; also add to return array(1) 6th, 7th piece = IM & CO ord count
- ; also add to return array order line 32 piece, Clinic name for
- ; CO orders.
- ;*83 - cleanup variables here instead of in each tab rtn
- ;
- ; ** Warning: PSBSIOPI & PSBCLINORD will be used as global variables
- ; for all down stream calls from this RPC tag.
- ;
- RPC(RESULTS,DFN,PSBTAB,PSBDT,PSBSIOPI,PSBCLINORD,PSBSRCHDIR) ;
- N PSBCNT,PSBORDCNT,PSBPATCH,PSBINFUS,PSBIVSTP,PSBA ;*70
- N PSBNOW ;*83
- K RESULTS,^TMP("PSB",$J),^TMP("PSJ",$J)
- S PSBSIOPI=+$G(PSBSIOPI) ;*68 init to 0 if not present or 1 if sent
- S PSBCLINORD=+$G(PSBCLINORD) ;*70 set to 0 if NULL
- S PSBSRCHDIR=$$UP^XLFSTR($G(PSBSRCHDIR)) ;*70 set to NULL/upper
- S PSBTRFL=0
- S RESULTS=$NAME(^TMP("PSB",$J,PSBTAB))
- ;
- Q:$$DECEASED(DFN)
- ;
- ;Set date & time window varaibles
- ;
- S PSBNOW=+$G(PSBDT)
- I 'PSBNOW D NOW^%DTC S PSBNOW=+$E(%,1,10)
- S PSBDT=$P(PSBNOW,".",1)
- ;
- ;check if fast search requested and valid direction passed, then
- ; get the next date tha order data exists and Not Given
- I PSBCLINORD,(PSBSRCHDIR="B")!(PSBSRCHDIR="F") D
- . N PSBSRCHDT,SRCHDIR
- . S SRCHDIR=$S(PSBSRCHDIR="B":-1,1:1)
- . S PSBSRCHDT=$$FINDORD^PSBVDLU1(SRCHDIR,DFN,PSBDT,PSBTAB)
- . S:PSBSRCHDT'=-1 (PSBNOW,PSBDT)=PSBSRCHDT
- ;
- ;*70 - if CO, set window of time to the entire day
- I PSBCLINORD D
- .S PSBWBEG=$P(PSBDT,".")_".0000"
- .S PSBWEND=$P(PSBDT,".")_".2400"
- E D
- .S PSBWBEG=$$FMADD^XLFDT(PSBNOW,"",-12)
- .S PSBWEND=$$FMADD^XLFDT(PSBNOW,"",12)
- ;
- ;Create variable for valid order start date/time against admin window
- S PSBWADM=$$GET^XPAR("DIV","PSB ADMIN BEFORE")
- S:PSBCLINORD PSBWADM=99999
- D NOW^%DTC S PSBWADM=$$FMADD^XLFDT(%,"","",+PSBWADM) ; correction for start date issue, PSB*3*78
- ;
- ;Use last movement for API
- S VAIP("D")="LAST" D IN5^VADPT S PSBTRDT=+VAIP(3),PSBTRTYP=$P(VAIP(2),U,2),PSBMVTYP=$P(VAIP(4),U,2) K VAIP
- ;
- ;Get patient transfer notification timeframe to determine pop-up box
- S PSBPTTR=$$GET^XPAR("DIV","PSB PATIENT TRANSFER") I PSBPTTR="" S PSBPTTR=72
- D NOW^%DTC S PSBNTDT=$$FMADD^XLFDT(%,"",-PSBPTTR) I PSBNTDT'>PSBTRDT S PSBTRFL=1
- ;
- ;Passing PSBDT as 3rd parameter turns off the V.1.0 One-Time lookback
- ;*70 check if IM or CO orders exists for mode lights
- S PSBORDCNT=$$MODELITE^PSBVDLU1 ;mode lights
- S PSBPATCH=$$PATCHON^PSBVDLU1(DFN,.PSBA) ;patch on light
- S:PSBA("I") $P(PSBORDCNT,U)=1 S:PSBA("C") $P(PSBORDCNT,U,2)=1
- S PSBIVSTP=$$STOPPED^PSBVDLU1(DFN,.PSBA) ;IV stopped light
- S:PSBA("I") $P(PSBORDCNT,U)=1 S:PSBA("C") $P(PSBORDCNT,U,2)=1
- S PSBINFUS=$$INFUSING^PSBVDLU1(DFN,.PSBA) ;IV infusing light
- S:PSBA("I") $P(PSBORDCNT,U)=1 S:PSBA("C") $P(PSBORDCNT,U,2)=1
- ;
- ; Setup the ^TMP("PSJ",$J global for use below
- K ^TMP("PSJ",$J)
- K PSJ ;P147
- D EN^PSJBCMA(DFN,PSBNOW,PSBDT)
- D:PSBCLINORD INCLUDCO^PSBVDLU1
- D:'PSBCLINORD REMOVECO^PSBVDLU1
- ;
- ;initialize tabs
- D TABINIT
- ;
- ;The following calls must be made in the order below since the ^TMP global is reused
- D EN^PSBVDLUD(DFN,PSBDT)
- D EN^PSBVDLPB(DFN,PSBDT)
- D EN^PSBVDLIV(DFN,PSBDT)
- ; adding a special check for lighting the Unit Dose Tab light.
- ; Patches sent to GUI via this API will send both IM and CO patches
- ; that are expired/dc'd and are still on the patient. So there is a
- ; a scenario when a unit dose patch can be on TMP global and it is
- ; the only order in TMP but was for a different mode than currently
- ; viewing. In this case CNT will = 0 and use it to turn on the light
- N CNT,QQ,NODE S CNT=0
- I $D(^TMP("PSB",$J,"UDTAB",2))>0 D ;unit dose tab check *70
- . F QQ=2:1 Q:'$D(^TMP("PSB",$J,"UDTAB",QQ)) D Q:CNT
- .. S NODE=^TMP("PSB",$J,"UDTAB",QQ)
- .. I $L(NODE,U)>27,$P(NODE,U,2)?.N1A D
- ... ; first order found Activ per correct mode, then quit with cnt=1
- ... I PSBCLINORD,$P(NODE,U,33),($P(NODE,U,22)="A"!($P(NODE,U,22)="H")!($P(NODE,U,22)="R")) S CNT=1 Q
- ... I 'PSBCLINORD,'$P(NODE,U,33),($P(NODE,U,22)="A"!($P(NODE,U,22)="H")!($P(NODE,U,22)="R")) S CNT=1 Q
- ... Q:'$P(NODE,U,28) ;not a given patch
- ... I PSBCLINORD,$P($P(NODE,U,26),".")'>DT,'$P(NODE,U,33) Q
- ... I 'PSBCLINORD,$P($P(NODE,U,26),".")'>DT,$P(NODE,U,33) Q
- ... S CNT=1
- S $P(PSBATAB,U,1)=$S(CNT:1,1:0) ;*70 use CNT for UD light
- S $P(PSBATAB,U,2)=$S($D(^TMP("PSB",$J,"PBTAB",2))>0:1,1:0)
- S $P(PSBATAB,U,3)=$S($D(^TMP("PSB",$J,"IVTAB",2))>0:1,1:0)
- S:PSBTAB="UDTAB" PSBCNT=$O(^TMP("PSB",$J,"UDTAB",""),-1)
- S:PSBTAB="IVTAB" PSBCNT=$O(^TMP("PSB",$J,"IVTAB",""),-1)
- S:PSBTAB="PBTAB" PSBCNT=$O(^TMP("PSB",$J,"PBTAB",""),-1)
- ;
- I PSBTAB="NO TAB" D
- .S ^TMP("PSB",$J,PSBTAB,0)=1
- .S ^TMP("PSB",$J,PSBTAB,1)=PSBATAB
- .S $P(^TMP("PSB",$J,PSBTAB,1),U,5,6)=PSBORDCNT ;*70 Cvsht offset cnt
- .S $P(^TMP("PSB",$J,PSBTAB,1),U,7)=PSBINFUS ;*70 IV infuse light
- .S $P(^TMP("PSB",$J,PSBTAB,1),U,8)=PSBIVSTP ;*70 IV stop light
- .S $P(^TMP("PSB",$J,PSBTAB,1),U,9)=PSBPATCH ;*70 patch light
- E D
- .I $G(PSBCNT)>0 S ^TMP("PSB",$J,PSBTAB,0)=PSBCNT
- .I $G(PSBCNT)>1 S ^TMP("PSB",$J,PSBTAB,1)=PSBATAB_U_$S(PSBTRFL:PSBTRTYP_U_PSBMVTYP,1:"")
- .I $G(PSBCNT)'>1 S ^TMP("PSB",$J,PSBTAB,1)=PSBATAB
- .S $P(^TMP("PSB",$J,PSBTAB,1),U,6,7)=PSBORDCNT ;*70 Tabs Ord cnt
- .S $P(^TMP("PSB",$J,PSBTAB,1),U,8)=PSBINFUS ;*70 IV infuse light
- .S $P(^TMP("PSB",$J,PSBTAB,1),U,9)=PSBIVSTP ;*70 IV stop light
- .S $P(^TMP("PSB",$J,PSBTAB,1),U,10)=PSBPATCH ;*70 patch light
- ;
- F X="UDTAB","PBTAB","IVTAB" I X'=PSBTAB K ^TMP("PSB",$J,X)
- D CLEAN^PSBVT
- K ^TMP("PSJ",$J),PSBATAB,PSBWADM,PSBWBEG,PSBWEND,PSBNOW,PSBTRDT,PSBPTTR,PSBTRFL,PSBNTDT,PSBTRTYP,PSBMVTYP ;*83
- Q
- ;
- TABINIT ;
- F PSBX="UDTAB","PBTAB","IVTAB" D
- .K ^TMP("PSB",$J,PSBX)
- .S ^TMP("PSB",$J,PSBX,0)=1
- .S ^TMP("PSB",$J,PSBX,1)="-1^No Administration(s) due at this time." Q
- ;
- DECEASED(DFN) ; Patient Deceased?
- ;
- S DECEASED=0
- D DEM^VADPT I VADM(6)]"" S DECEASED=1 K VADM D Q DECEASED
- .F PSBX="UDTAB","PBTAB","IVTAB","NO TAB" D
- ..K ^TMP("PSB",$J,PSBX)
- ..S ^TMP("PSB",$J,PSBX,0)=1,^TMP("PSB",$J,PSBX,1)="0^0^0^-1^A ""DATE OF DEATH"" has been logged for this patient."
- Q DECEASED
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBVDLTB 6772 printed Feb 18, 2025@23:07:43 Page 2
- PSBVDLTB ;BIRMINGHAM/EFC-BCMA VIRTUAL DUE LIST FUNCTIONS (CONT) ;03/06/16 3:06pm
- +1 ;;3.0;BAR CODE MED ADMIN;**3,4,16,68,70,78,83,92,147**;Mar 2004;Build 1
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; Reference/IA
- +5 ; EN^PSJBCMA/2828
- +6 ; IN5^VADPT/10061
- +7 ; DEM^VADPT/10061
- +8 ; INP^VADPT/10061
- +9 ; $$FMADD^XLFDT/10103
- +10 ; $$GET^XPAR/2263
- +11 ;
- +12 ;*68 - add new parameter to use new SI/OPI word processing fields
- +13 ;*70 - add Clinic order request IN param flag (true/false 0/1).
- +14 ; also add to return array(1) 6th, 7th piece = IM & CO ord count
- +15 ; also add to return array order line 32 piece, Clinic name for
- +16 ; CO orders.
- +17 ;*83 - cleanup variables here instead of in each tab rtn
- +18 ;
- +19 ; ** Warning: PSBSIOPI & PSBCLINORD will be used as global variables
- +20 ; for all down stream calls from this RPC tag.
- +21 ;
- RPC(RESULTS,DFN,PSBTAB,PSBDT,PSBSIOPI,PSBCLINORD,PSBSRCHDIR) ;
- +1 ;*70
- NEW PSBCNT,PSBORDCNT,PSBPATCH,PSBINFUS,PSBIVSTP,PSBA
- +2 ;*83
- NEW PSBNOW
- +3 KILL RESULTS,^TMP("PSB",$JOB),^TMP("PSJ",$JOB)
- +4 ;*68 init to 0 if not present or 1 if sent
- SET PSBSIOPI=+$GET(PSBSIOPI)
- +5 ;*70 set to 0 if NULL
- SET PSBCLINORD=+$GET(PSBCLINORD)
- +6 ;*70 set to NULL/upper
- SET PSBSRCHDIR=$$UP^XLFSTR($GET(PSBSRCHDIR))
- +7 SET PSBTRFL=0
- +8 SET RESULTS=$NAME(^TMP("PSB",$JOB,PSBTAB))
- +9 ;
- +10 if $$DECEASED(DFN)
- QUIT
- +11 ;
- +12 ;Set date & time window varaibles
- +13 ;
- +14 SET PSBNOW=+$GET(PSBDT)
- +15 IF 'PSBNOW
- DO NOW^%DTC
- SET PSBNOW=+$EXTRACT(%,1,10)
- +16 SET PSBDT=$PIECE(PSBNOW,".",1)
- +17 ;
- +18 ;check if fast search requested and valid direction passed, then
- +19 ; get the next date tha order data exists and Not Given
- +20 IF PSBCLINORD
- IF (PSBSRCHDIR="B")!(PSBSRCHDIR="F")
- Begin DoDot:1
- +21 NEW PSBSRCHDT,SRCHDIR
- +22 SET SRCHDIR=$SELECT(PSBSRCHDIR="B":-1,1:1)
- +23 SET PSBSRCHDT=$$FINDORD^PSBVDLU1(SRCHDIR,DFN,PSBDT,PSBTAB)
- +24 if PSBSRCHDT'=-1
- SET (PSBNOW,PSBDT)=PSBSRCHDT
- End DoDot:1
- +25 ;
- +26 ;*70 - if CO, set window of time to the entire day
- +27 IF PSBCLINORD
- Begin DoDot:1
- +28 SET PSBWBEG=$PIECE(PSBDT,".")_".0000"
- +29 SET PSBWEND=$PIECE(PSBDT,".")_".2400"
- End DoDot:1
- +30 IF '$TEST
- Begin DoDot:1
- +31 SET PSBWBEG=$$FMADD^XLFDT(PSBNOW,"",-12)
- +32 SET PSBWEND=$$FMADD^XLFDT(PSBNOW,"",12)
- End DoDot:1
- +33 ;
- +34 ;Create variable for valid order start date/time against admin window
- +35 SET PSBWADM=$$GET^XPAR("DIV","PSB ADMIN BEFORE")
- +36 if PSBCLINORD
- SET PSBWADM=99999
- +37 ; correction for start date issue, PSB*3*78
- DO NOW^%DTC
- SET PSBWADM=$$FMADD^XLFDT(%,"","",+PSBWADM)
- +38 ;
- +39 ;Use last movement for API
- +40 SET VAIP("D")="LAST"
- DO IN5^VADPT
- SET PSBTRDT=+VAIP(3)
- SET PSBTRTYP=$PIECE(VAIP(2),U,2)
- SET PSBMVTYP=$PIECE(VAIP(4),U,2)
- KILL VAIP
- +41 ;
- +42 ;Get patient transfer notification timeframe to determine pop-up box
- +43 SET PSBPTTR=$$GET^XPAR("DIV","PSB PATIENT TRANSFER")
- IF PSBPTTR=""
- SET PSBPTTR=72
- +44 DO NOW^%DTC
- SET PSBNTDT=$$FMADD^XLFDT(%,"",-PSBPTTR)
- IF PSBNTDT'>PSBTRDT
- SET PSBTRFL=1
- +45 ;
- +46 ;Passing PSBDT as 3rd parameter turns off the V.1.0 One-Time lookback
- +47 ;*70 check if IM or CO orders exists for mode lights
- +48 ;mode lights
- SET PSBORDCNT=$$MODELITE^PSBVDLU1
- +49 ;patch on light
- SET PSBPATCH=$$PATCHON^PSBVDLU1(DFN,.PSBA)
- +50 if PSBA("I")
- SET $PIECE(PSBORDCNT,U)=1
- if PSBA("C")
- SET $PIECE(PSBORDCNT,U,2)=1
- +51 ;IV stopped light
- SET PSBIVSTP=$$STOPPED^PSBVDLU1(DFN,.PSBA)
- +52 if PSBA("I")
- SET $PIECE(PSBORDCNT,U)=1
- if PSBA("C")
- SET $PIECE(PSBORDCNT,U,2)=1
- +53 ;IV infusing light
- SET PSBINFUS=$$INFUSING^PSBVDLU1(DFN,.PSBA)
- +54 if PSBA("I")
- SET $PIECE(PSBORDCNT,U)=1
- if PSBA("C")
- SET $PIECE(PSBORDCNT,U,2)=1
- +55 ;
- +56 ; Setup the ^TMP("PSJ",$J global for use below
- +57 KILL ^TMP("PSJ",$JOB)
- +58 ;P147
- KILL PSJ
- +59 DO EN^PSJBCMA(DFN,PSBNOW,PSBDT)
- +60 if PSBCLINORD
- DO INCLUDCO^PSBVDLU1
- +61 if 'PSBCLINORD
- DO REMOVECO^PSBVDLU1
- +62 ;
- +63 ;initialize tabs
- +64 DO TABINIT
- +65 ;
- +66 ;The following calls must be made in the order below since the ^TMP global is reused
- +67 DO EN^PSBVDLUD(DFN,PSBDT)
- +68 DO EN^PSBVDLPB(DFN,PSBDT)
- +69 DO EN^PSBVDLIV(DFN,PSBDT)
- +70 ; adding a special check for lighting the Unit Dose Tab light.
- +71 ; Patches sent to GUI via this API will send both IM and CO patches
- +72 ; that are expired/dc'd and are still on the patient. So there is a
- +73 ; a scenario when a unit dose patch can be on TMP global and it is
- +74 ; the only order in TMP but was for a different mode than currently
- +75 ; viewing. In this case CNT will = 0 and use it to turn on the light
- +76 NEW CNT,QQ,NODE
- SET CNT=0
- +77 ;unit dose tab check *70
- IF $DATA(^TMP("PSB",$JOB,"UDTAB",2))>0
- Begin DoDot:1
- +78 FOR QQ=2:1
- if '$DATA(^TMP("PSB",$JOB,"UDTAB",QQ))
- QUIT
- Begin DoDot:2
- +79 SET NODE=^TMP("PSB",$JOB,"UDTAB",QQ)
- +80 IF $LENGTH(NODE,U)>27
- IF $PIECE(NODE,U,2)?.N1A
- Begin DoDot:3
- +81 ; first order found Activ per correct mode, then quit with cnt=1
- +82 IF PSBCLINORD
- IF $PIECE(NODE,U,33)
- IF ($PIECE(NODE,U,22)="A"!($PIECE(NODE,U,22)="H")!($PIECE(NODE,U,22)="R"))
- SET CNT=1
- QUIT
- +83 IF 'PSBCLINORD
- IF '$PIECE(NODE,U,33)
- IF ($PIECE(NODE,U,22)="A"!($PIECE(NODE,U,22)="H")!($PIECE(NODE,U,22)="R"))
- SET CNT=1
- QUIT
- +84 ;not a given patch
- if '$PIECE(NODE,U,28)
- QUIT
- +85 IF PSBCLINORD
- IF $PIECE($PIECE(NODE,U,26),".")'>DT
- IF '$PIECE(NODE,U,33)
- QUIT
- +86 IF 'PSBCLINORD
- IF $PIECE($PIECE(NODE,U,26),".")'>DT
- IF $PIECE(NODE,U,33)
- QUIT
- +87 SET CNT=1
- End DoDot:3
- End DoDot:2
- if CNT
- QUIT
- End DoDot:1
- +88 ;*70 use CNT for UD light
- SET $PIECE(PSBATAB,U,1)=$SELECT(CNT:1,1:0)
- +89 SET $PIECE(PSBATAB,U,2)=$SELECT($DATA(^TMP("PSB",$JOB,"PBTAB",2))>0:1,1:0)
- +90 SET $PIECE(PSBATAB,U,3)=$SELECT($DATA(^TMP("PSB",$JOB,"IVTAB",2))>0:1,1:0)
- +91 if PSBTAB="UDTAB"
- SET PSBCNT=$ORDER(^TMP("PSB",$JOB,"UDTAB",""),-1)
- +92 if PSBTAB="IVTAB"
- SET PSBCNT=$ORDER(^TMP("PSB",$JOB,"IVTAB",""),-1)
- +93 if PSBTAB="PBTAB"
- SET PSBCNT=$ORDER(^TMP("PSB",$JOB,"PBTAB",""),-1)
- +94 ;
- +95 IF PSBTAB="NO TAB"
- Begin DoDot:1
- +96 SET ^TMP("PSB",$JOB,PSBTAB,0)=1
- +97 SET ^TMP("PSB",$JOB,PSBTAB,1)=PSBATAB
- +98 ;*70 Cvsht offset cnt
- SET $PIECE(^TMP("PSB",$JOB,PSBTAB,1),U,5,6)=PSBORDCNT
- +99 ;*70 IV infuse light
- SET $PIECE(^TMP("PSB",$JOB,PSBTAB,1),U,7)=PSBINFUS
- +100 ;*70 IV stop light
- SET $PIECE(^TMP("PSB",$JOB,PSBTAB,1),U,8)=PSBIVSTP
- +101 ;*70 patch light
- SET $PIECE(^TMP("PSB",$JOB,PSBTAB,1),U,9)=PSBPATCH
- End DoDot:1
- +102 IF '$TEST
- Begin DoDot:1
- +103 IF $GET(PSBCNT)>0
- SET ^TMP("PSB",$JOB,PSBTAB,0)=PSBCNT
- +104 IF $GET(PSBCNT)>1
- SET ^TMP("PSB",$JOB,PSBTAB,1)=PSBATAB_U_$SELECT(PSBTRFL:PSBTRTYP_U_PSBMVTYP,1:"")
- +105 IF $GET(PSBCNT)'>1
- SET ^TMP("PSB",$JOB,PSBTAB,1)=PSBATAB
- +106 ;*70 Tabs Ord cnt
- SET $PIECE(^TMP("PSB",$JOB,PSBTAB,1),U,6,7)=PSBORDCNT
- +107 ;*70 IV infuse light
- SET $PIECE(^TMP("PSB",$JOB,PSBTAB,1),U,8)=PSBINFUS
- +108 ;*70 IV stop light
- SET $PIECE(^TMP("PSB",$JOB,PSBTAB,1),U,9)=PSBIVSTP
- +109 ;*70 patch light
- SET $PIECE(^TMP("PSB",$JOB,PSBTAB,1),U,10)=PSBPATCH
- End DoDot:1
- +110 ;
- +111 FOR X="UDTAB","PBTAB","IVTAB"
- IF X'=PSBTAB
- KILL ^TMP("PSB",$JOB,X)
- +112 DO CLEAN^PSBVT
- +113 ;*83
- KILL ^TMP("PSJ",$JOB),PSBATAB,PSBWADM,PSBWBEG,PSBWEND,PSBNOW,PSBTRDT,PSBPTTR,PSBTRFL,PSBNTDT,PSBTRTYP,PSBMVTYP
- +114 QUIT
- +115 ;
- TABINIT ;
- +1 FOR PSBX="UDTAB","PBTAB","IVTAB"
- Begin DoDot:1
- +2 KILL ^TMP("PSB",$JOB,PSBX)
- +3 SET ^TMP("PSB",$JOB,PSBX,0)=1
- +4 SET ^TMP("PSB",$JOB,PSBX,1)="-1^No Administration(s) due at this time."
- QUIT
- End DoDot:1
- +5 ;
- DECEASED(DFN) ; Patient Deceased?
- +1 ;
- +2 SET DECEASED=0
- +3 DO DEM^VADPT
- IF VADM(6)]""
- SET DECEASED=1
- KILL VADM
- Begin DoDot:1
- +4 FOR PSBX="UDTAB","PBTAB","IVTAB","NO TAB"
- Begin DoDot:2
- +5 KILL ^TMP("PSB",$JOB,PSBX)
- +6 SET ^TMP("PSB",$JOB,PSBX,0)=1
- SET ^TMP("PSB",$JOB,PSBX,1)="0^0^0^-1^A ""DATE OF DEATH"" has been logged for this patient."
- End DoDot:2
- End DoDot:1
- QUIT DECEASED
- +7 QUIT DECEASED
