PSBVDLTB.m

PSBVDLTB ;BIRMINGHAM/EFC-BCMA VIRTUAL DUE LIST FUNCTIONS (CONT) ;Mar 2004

 ;;3.0;BAR CODE MED ADMIN;**3,4,16**;Mar 2004

 ;

 ; Reference/IA

 ; EN^PSJBCMA/2828

 ; IN5^VADPT/10061

 ; DEM^VADPT/10061

 ; INP^VADPT/10061

 ; $$FMADD^XLFDT/10103

 ; $$GET^XPAR/2263

 ; 

 ;

RPC(RESULTS,DFN,PSBTAB,PSBDT) ;

 K RESULTS,^TMP("PSB",$J),^TMP("PSJ",$J)

 N PSBCNT

 S PSBTRFL=0

 S RESULTS=$NAME(^TMP("PSB",$J,PSBTAB))

 ;

 Q:$$DISCHRGD(DFN)

 ;

 S PSBNOW=+$G(PSBDT)

 I 'PSBNOW D NOW^%DTC S PSBNOW=+$E(%,1,10),PSBDT=$P(%,".",1)

 ; use fileman function to determine window

 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")

 D NOW^%DTC S PSBWADM=$$FMADD^XLFDT(%,"","",+PSBWADM)

 ;

 ; 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

 ;determine order type and load to table

 ;

 ; Setup the ^TMP("PSJ",$J global for use below 

 ; Passing PSBDT as 3rd parameter turns off the V.1.0 One-Time lookback

 D EN^PSJBCMA(DFN,PSBNOW,PSBDT)

 ;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),EN^PSBVDLPB(DFN,PSBDT),EN^PSBVDLIV(DFN,PSBDT)

 S $P(PSBATAB,U,1)=$S($D(^TMP("PSB",$J,"UDTAB",2))>0:1,1:0)

 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

 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_U_^TMP("PSB",$J,PSBTAB,1)

 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

 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

 Q

 ;

DISCHRGD(DFN) ; Patient Discharged OR Deceased?

 ;

 S DISCHRGD=0

 D DEM^VADPT I VADM(6)]"" S DISCHRGD=1 K VADM D  Q DISCHRGD

 .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."

 D INP^VADPT I VAIN(1)']"" S DISCHRGD=1 K VAIN D  Q DISCHRGD

 .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^The selected patient has been DISCHARGED."

 Q DISCHRGD

 ;

PSBVDLTB  ;BIRMINGHAM/EFC-BCMA VIRTUAL DUE LIST FUNCTIONS (CONT) ;Mar 2004

 +1       ;;3.0;BAR CODE MED ADMIN;**3,4,16**;Mar 2004

 +2       ;

 +3       ; Reference/IA

 +4       ; EN^PSJBCMA/2828

 +5       ; IN5^VADPT/10061

 +6       ; DEM^VADPT/10061

 +7       ; INP^VADPT/10061

 +8       ; $$FMADD^XLFDT/10103

 +9       ; $$GET^XPAR/2263

 +10      ; 

 +11      ;

RPC(RESULTS,DFN,PSBTAB,PSBDT) ;

 +1        KILL RESULTS,^TMP("PSB",$JOB),^TMP("PSJ",$JOB)

 +2        NEW PSBCNT

 +3        SET PSBTRFL=0

 +4        SET RESULTS=$NAME(^TMP("PSB",$JOB,PSBTAB))

 +5       ;

 +6        IF $$DISCHRGD(DFN)

               QUIT 

 +7       ;

 +8        SET PSBNOW=+$GET(PSBDT)

 +9        IF 'PSBNOW

               DO NOW^%DTC

               SET PSBNOW=+$EXTRACT(%,1,10)

               SET PSBDT=$PIECE(%,".",1)

 +10      ; use fileman function to determine window

 +11       SET PSBWBEG=$$FMADD^XLFDT(PSBNOW,"",-12)

 +12       SET PSBWEND=$$FMADD^XLFDT(PSBNOW,"",12)

 +13      ;

 +14      ; Create variable for valid order start date/time against admin window

 +15       SET PSBWADM=$$GET^XPAR("DIV","PSB ADMIN BEFORE")

 +16       DO NOW^%DTC

           SET PSBWADM=$$FMADD^XLFDT(%,"","",+PSBWADM)

 +17      ;

 +18      ; use last movement for API

 +19       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

 +20      ;

 +21      ;Get patient transfer notification timeframe to determine pop-up box

 +22       SET PSBPTTR=$$GET^XPAR("DIV","PSB PATIENT TRANSFER")

           IF PSBPTTR=""

               SET PSBPTTR=72

 +23       DO NOW^%DTC

           SET PSBNTDT=$$FMADD^XLFDT(%,"",-PSBPTTR)

           IF PSBNTDT'>PSBTRDT

               SET PSBTRFL=1

 +24      ;determine order type and load to table

 +25      ;

 +26      ; Setup the ^TMP("PSJ",$J global for use below 

 +27      ; Passing PSBDT as 3rd parameter turns off the V.1.0 One-Time lookback

 +28       DO EN^PSJBCMA(DFN,PSBNOW,PSBDT)

 +29      ;initialize tabs

 +30       DO TABINIT

 +31      ;

 +32      ;The following calls must be made in the order below since the ^TMP global is reused

 +33       DO EN^PSBVDLUD(DFN,PSBDT)

           DO EN^PSBVDLPB(DFN,PSBDT)

           DO EN^PSBVDLIV(DFN,PSBDT)

 +34       SET $PIECE(PSBATAB,U,1)=$SELECT($DATA(^TMP("PSB",$JOB,"UDTAB",2))>0:1,1:0)

 +35       SET $PIECE(PSBATAB,U,2)=$SELECT($DATA(^TMP("PSB",$JOB,"PBTAB",2))>0:1,1:0)

 +36       SET $PIECE(PSBATAB,U,3)=$SELECT($DATA(^TMP("PSB",$JOB,"IVTAB",2))>0:1,1:0)

 +37       IF PSBTAB="UDTAB"

               SET PSBCNT=$ORDER(^TMP("PSB",$JOB,"UDTAB",""),-1)

 +38       IF PSBTAB="IVTAB"

               SET PSBCNT=$ORDER(^TMP("PSB",$JOB,"IVTAB",""),-1)

 +39       IF PSBTAB="PBTAB"

               SET PSBCNT=$ORDER(^TMP("PSB",$JOB,"PBTAB",""),-1)

 +40       IF PSBTAB="NO TAB"

               Begin DoDot:1

 +41               SET ^TMP("PSB",$JOB,PSBTAB,0)=1

 +42               SET ^TMP("PSB",$JOB,PSBTAB,1)=PSBATAB

               End DoDot:1

 +43      IF '$TEST

               Begin DoDot:1

 +44               IF $GET(PSBCNT)>0

                       SET ^TMP("PSB",$JOB,PSBTAB,0)=PSBCNT

 +45               IF $GET(PSBCNT)>1

                       SET ^TMP("PSB",$JOB,PSBTAB,1)=PSBATAB_U_$SELECT(PSBTRFL:PSBTRTYP_U_PSBMVTYP,1:"")

 +46               IF $GET(PSBCNT)'>1

                       SET ^TMP("PSB",$JOB,PSBTAB,1)=PSBATAB_U_^TMP("PSB",$JOB,PSBTAB,1)

               End DoDot:1

 +47       FOR X="UDTAB","PBTAB","IVTAB"

               IF X'=PSBTAB

                   KILL ^TMP("PSB",$JOB,X)

 +48       DO CLEAN^PSBVT

           KILL ^TMP("PSJ",$JOB),PSBATAB,PSBWADM,PSBWBEG,PSBWEND,PSBNOW,PSBTRDT,PSBPTTR,PSBTRFL,PSBNTDT,PSBTRTYP,PSBMVTYP

 +49       QUIT 

 +50      ;

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        QUIT 

 +6       ;

DISCHRGD(DFN) ; Patient Discharged OR Deceased?

 +1       ;

 +2        SET DISCHRGD=0

 +3        DO DEM^VADPT

           IF VADM(6)]""

               SET DISCHRGD=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 DISCHRGD

 +7        DO INP^VADPT

           IF VAIN(1)']""

               SET DISCHRGD=1

               KILL VAIN

               Begin DoDot:1

 +8                FOR PSBX="UDTAB","PBTAB","IVTAB","NO TAB"

                       Begin DoDot:2

 +9                        KILL ^TMP("PSB",$JOB,PSBX)

 +10                       SET ^TMP("PSB",$JOB,PSBX,0)=1

                           SET ^TMP("PSB",$JOB,PSBX,1)="0^0^0^-1^The selected patient has been DISCHARGED."

                       End DoDot:2

               End DoDot:1

               QUIT DISCHRGD

 +11       QUIT DISCHRGD

 +12      ;