PSBOXA ;BIRMINGHAM/EFC-MEDICATION LOG ;Mar 2004
;;3.0;BAR CODE MED ADMIN;**13,81**;Mar 2004;Build 6
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference/IA
;
; File 4/10090
;
;
; Entry Point - Report OPTION used by PSB MANAGER key holders to locate
; "UNKNOWN" Action Status entries in the BCMA Medication Log File.
;
EN ; UNKNOWN Action Status Report - creation!
;
S PSBDTST=+$P(PSBRPT(.1),U,6)
S PSBDTSP=+$P(PSBRPT(.1),U,8)
D NOW^%DTC S Y=% D DD^%DT S PSBDTTM=Y
S PSBLIST=""
S (PSBPGNUM,PSBLNTOT,PSBTOT,PSBX1)=""
F S PSBX1=$O(^PSB(53.79,"AADT",PSBX1)) Q:PSBX1="" D
.S PSBX2=$$FMADD^XLFDT(PSBDTST,,,,-.1) F S PSBX2=$O(^PSB(53.79,"AADT",PSBX1,PSBX2)) Q:(PSBX2>$$FMADD^XLFDT(PSBDTSP,,23.9999))!(+PSBX2=0) D
..S PSBX3="" F S PSBX3=$O(^PSB(53.79,"AADT",PSBX1,PSBX2,PSBX3)) Q:+PSBX3=0 D
...Q:('$D(^PSB(53.79,PSBX3,0)))!$D(PSBLIST(PSBX3))
...I $P(^PSB(53.79,PSBX3,0),U,9)="" I $$GET1^DIQ(4,$P(PSBRPT(0),U,4)_",",.01)=$$GET1^DIQ(4,$P(^PSB(53.79,PSBX3,0),U,3)_",",.01) D
....L +^PSB(53.79,PSBX3):1 I L -^PSB(53.79,PSBX3) S PSBTOT=PSBTOT+1,PSBLIST(PSBX3)=""
I +PSBTOT=0 K PSBLIST
S Y=PSBDTST D DD^%DT S Y1=Y S Y=PSBDTSP D DD^%DT S Y2=Y
D BLDRPT
D WRTRPT
Q
;
BLDRPT ;
;
K PSBOUTP
S (PSBPGNUM,PSBX1)=""
I '$D(PSBLIST) D Q
.S PSBPGNUM=1
.S PSBOUTP(0,14)="W !!,""<<<< NO """"UNKNOWN ACTION STATUS"""" ENTRIES FOUND FOR THIS DATE RANGE >>>>"",!!"
S PSBPGNUM=1,PSBTOT1=0
F S PSBX1=$O(PSBLIST(PSBX1)) Q:+PSBX1=0 D
.S PSBTOT1=PSBTOT1+1
.D CLEAN^PSBVT,PSJ1^PSBVT($$GET1^DIQ(53.79,PSBX1_",",.01,"I"),$$GET1^DIQ(53.79,PSBX1_",",.11))
.S PSBOUTP($$PGTOT,PSBLNTOT)="W """_PSBTOT1_".)"",!,?5,""Action Status...: "_$S($$GET1^DIQ(53.79,PSBX1_",",.09)']"":"*UNKNOWN*",1:$$GET1^DIQ(53.79,PSBX1_",",.09))_""""
.S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Patient.........: ("_$S(DUZ("AG")="I":$$HRN^AUPNPAT(PSBDFN,DUZ(2)),1:$$GET1^DIQ(2,PSBDFN_",",.09))_") "_$$GET1^DIQ(2,PSBDFN_",",.01)_"""" ;add code for IHS, PSB*3*81
.S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Ward/Bed........: "_$$GET1^DIQ(2,PSBDFN_",",.1)_$S($$GET1^DIQ(2,PSBDFN_",",.101)']"":"",1:"/"_$$GET1^DIQ(2,PSBDFN_",",.101))_""""
.S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Order Number....: "_PSBONX_""""
.S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Orderable Item..: "_PSBOITX_""""
.S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Schedule........: "_PSBSCH_""""
.S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Scheduled Adm Tm: "_$S($$GET1^DIQ(53.79,PSBX1_",",.13)']"":"AS NEEDED",1:$$GET1^DIQ(53.79,PSBX1_",",.13))_""""
.S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Created Dt/Tm...: "_$$GET1^DIQ(53.79,PSBX1_",",.06)_""""
.S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Created By......: ("_$$GET1^DIQ(53.79,PSBX1_",",.07,"I")_") "_$$GET1^DIQ(53.79,PSBX1_",",.07)_""""
.S PSBOUTP($$PGTOT(3),PSBLNTOT)="W !,$TR($J("""",IOM),"" "",""-""),!!"
Q
;
WRTRPT ; Actually "WRITE" the report to output device
;
I $O(PSBOUTP(""),-1)<1 D Q
.D HDR
.X PSBOUTP($O(PSBOUTP(""),-1),14)
.D FTR
S PSBPGNUM=1
D HDR
S PSBX1="" F S PSBX1=$O(PSBOUTP(PSBX1)) Q:PSBX1="" D
.I PSBPGNUM'=PSBX1 D FTR S PSBPGNUM=PSBX1 D HDR
.S PSBX2="" F S PSBX2=$O(PSBOUTP(PSBX1,PSBX2)) Q:PSBX2="" D
..X PSBOUTP(PSBX1,PSBX2)
D FTR
Q
;
HDR ; Create Report Header
;
;
; BAR CODE MEDICATION ADMINISTRATION (BCMA) UNKNOWN ACTION STATUS REPORT
; Date/Time: NOW
; Date Range: Y1 to Y2 (inculsive)
;
;
; This is a report of entries, created within the given date range, in the
; BCMA Medication Log File with UNKNOWN Action Status data.
; These entries may be corrected via the BCMA GUI "Edit Med Log".
;
;----------------------------------------------------------------
;
W:$Y>1 @IOF
W:$X>1 !
S PSBPG="Page: "_PSBPGNUM_" of "_$S($O(PSBOUTP(""),-1)=0:1,1:$O(PSBOUTP(""),-1))
S PSBPGRM=IOM-($L(PSBPG)+5)
I $P(PSBRPT(0),U,4)="" S $P(PSBRPT(0),U,4)=DUZ(2)
S PSBDIVN="Division: "_$$GET1^DIQ(4,$P(PSBRPT(0),U,4)_",",.01)
W !!,"BCMA UNKNOWN ACTION STATUS REPORT" W ?PSBPGRM,PSBPG
W !,"Date/Time: "_PSBDTTM,!,"Report Date Range: Start Date: "_Y1_" Stop Date: "_Y2
W !,PSBDIVN,?(IOM-($L("Total *UNKNOWN* entries found: "_+PSBTOT)+5)),"Total *UNKNOWN* entries found: "_+PSBTOT
W !!,?5,"This is a report of entries, created within the given date range,"
W !,?5,"in the BCMA Medication Log File with UNKNOWN Action Status data."
W !,?5,"These entries can be corrected using the BCMA GUI ""Edit Med Log""."
W !!,$TR($J("",IOM)," ","="),!!
;
Q
;
FTR ; Create Report Footer
;
I (IOSL<100) F Q:$Y>(IOSL-7) W !
W !,$TR($J("",IOM)," ","="),!
W !,PSBDTTM,!,"BCMA UNKNOWN ACTION STATUS REPORT - footer -"
W ?PSBPGRM,PSBPG,!
Q
;
PGTOT(X) ;Keep track of lines and PAGE Number...
;
S:'$D(X) PSBLNTOT=PSBLNTOT+1
S:$D(X) PSBLNTOT=PSBLNTOT+X
I PSBPGNUM=1,(PSBLNTOT=1) S PSBLNTOT=14 S PSBMORE=PSBLNTOT+12 Q PSBPGNUM
I PSBLNTOT=PSBMORE D
.S PSBMORE=PSBLNTOT+12
.I PSBMORE>(IOSL-7) S PSBPGNUM=PSBPGNUM+1,PSBLNTOT=14 S PSBMORE=PSBLNTOT+12
Q PSBPGNUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOXA 5075 printed Sep 23, 2025@19:16:57 Page 2
PSBOXA ;BIRMINGHAM/EFC-MEDICATION LOG ;Mar 2004
+1 ;;3.0;BAR CODE MED ADMIN;**13,81**;Mar 2004;Build 6
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ;
+6 ; File 4/10090
+7 ;
+8 ;
+9 ; Entry Point - Report OPTION used by PSB MANAGER key holders to locate
+10 ; "UNKNOWN" Action Status entries in the BCMA Medication Log File.
+11 ;
EN ; UNKNOWN Action Status Report - creation!
+1 ;
+2 SET PSBDTST=+$PIECE(PSBRPT(.1),U,6)
+3 SET PSBDTSP=+$PIECE(PSBRPT(.1),U,8)
+4 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSBDTTM=Y
+5 SET PSBLIST=""
+6 SET (PSBPGNUM,PSBLNTOT,PSBTOT,PSBX1)=""
+7 FOR
SET PSBX1=$ORDER(^PSB(53.79,"AADT",PSBX1))
if PSBX1=""
QUIT
Begin DoDot:1
+8 SET PSBX2=$$FMADD^XLFDT(PSBDTST,,,,-.1)
FOR
SET PSBX2=$ORDER(^PSB(53.79,"AADT",PSBX1,PSBX2))
if (PSBX2>$$FMADD^XLFDT(PSBDTSP,,23.9999))!(+PSBX2=0)
QUIT
Begin DoDot:2
+9 SET PSBX3=""
FOR
SET PSBX3=$ORDER(^PSB(53.79,"AADT",PSBX1,PSBX2,PSBX3))
if +PSBX3=0
QUIT
Begin DoDot:3
+10 if ('$DATA(^PSB(53.79,PSBX3,0)))!$DATA(PSBLIST(PSBX3))
QUIT
+11 IF $PIECE(^PSB(53.79,PSBX3,0),U,9)=""
IF $$GET1^DIQ(4,$PIECE(PSBRPT(0),U,4)_",",.01)=$$GET1^DIQ(4,$PIECE(^PSB(53.79,PSBX3,0),U,3)_",",.01)
Begin DoDot:4
+12 LOCK +^PSB(53.79,PSBX3):1
IF $TEST
LOCK -^PSB(53.79,PSBX3)
SET PSBTOT=PSBTOT+1
SET PSBLIST(PSBX3)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 IF +PSBTOT=0
KILL PSBLIST
+14 SET Y=PSBDTST
DO DD^%DT
SET Y1=Y
SET Y=PSBDTSP
DO DD^%DT
SET Y2=Y
+15 DO BLDRPT
+16 DO WRTRPT
+17 QUIT
+18 ;
BLDRPT ;
+1 ;
+2 KILL PSBOUTP
+3 SET (PSBPGNUM,PSBX1)=""
+4 IF '$DATA(PSBLIST)
Begin DoDot:1
+5 SET PSBPGNUM=1
+6 SET PSBOUTP(0,14)="W !!,""<<<< NO """"UNKNOWN ACTION STATUS"""" ENTRIES FOUND FOR THIS DATE RANGE >>>>"",!!"
End DoDot:1
QUIT
+7 SET PSBPGNUM=1
SET PSBTOT1=0
+8 FOR
SET PSBX1=$ORDER(PSBLIST(PSBX1))
if +PSBX1=0
QUIT
Begin DoDot:1
+9 SET PSBTOT1=PSBTOT1+1
+10 DO CLEAN^PSBVT
DO PSJ1^PSBVT($$GET1^DIQ(53.79,PSBX1_",",.01,"I"),$$GET1^DIQ(53.79,PSBX1_",",.11))
+11 SET PSBOUTP($$PGTOT,PSBLNTOT)="W """_PSBTOT1_".)"",!,?5,""Action Status...: "_$SELECT($$GET1^DIQ(53.79,PSBX1_",",.09)']"":"*UNKNOWN*",1:$$GET1^DIQ(53.79,PSBX1_",",.09))_""""
+12 ;add code for IHS, PSB*3*81
SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Patient.........: ("_$SELECT(DUZ("AG")="I":$$HRN^AUPNPAT(PSBDFN,DUZ(2)),1:$$GET1^DIQ(2,PSBDFN_",",.09))_") "_$$GET1^DIQ(2,PSBDFN_",",.01)_""""
+13 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Ward/Bed........: "_$$GET1^DIQ(2,PSBDFN_",",.1)_$SELECT($$GET1^DIQ(2,PSBDFN_",",.101)']"":"",1:"/"_$$GET1^DIQ(2,PSBDFN_",",.101))_""""
+14 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Order Number....: "_PSBONX_""""
+15 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Orderable Item..: "_PSBOITX_""""
+16 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Schedule........: "_PSBSCH_""""
+17 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Scheduled Adm Tm: "_$SELECT($$GET1^DIQ(53.79,PSBX1_",",.13)']"":"AS NEEDED",1:$$GET1^DIQ(53.79,PSBX1_",",.13))_""""
+18 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Created Dt/Tm...: "_$$GET1^DIQ(53.79,PSBX1_",",.06)_""""
+19 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Created By......: ("_$$GET1^DIQ(53.79,PSBX1_",",.07,"I")_") "_$$GET1^DIQ(53.79,PSBX1_",",.07)_""""
+20 SET PSBOUTP($$PGTOT(3),PSBLNTOT)="W !,$TR($J("""",IOM),"" "",""-""),!!"
End DoDot:1
+21 QUIT
+22 ;
WRTRPT ; Actually "WRITE" the report to output device
+1 ;
+2 IF $ORDER(PSBOUTP(""),-1)<1
Begin DoDot:1
+3 DO HDR
+4 XECUTE PSBOUTP($ORDER(PSBOUTP(""),-1),14)
+5 DO FTR
End DoDot:1
QUIT
+6 SET PSBPGNUM=1
+7 DO HDR
+8 SET PSBX1=""
FOR
SET PSBX1=$ORDER(PSBOUTP(PSBX1))
if PSBX1=""
QUIT
Begin DoDot:1
+9 IF PSBPGNUM'=PSBX1
DO FTR
SET PSBPGNUM=PSBX1
DO HDR
+10 SET PSBX2=""
FOR
SET PSBX2=$ORDER(PSBOUTP(PSBX1,PSBX2))
if PSBX2=""
QUIT
Begin DoDot:2
+11 XECUTE PSBOUTP(PSBX1,PSBX2)
End DoDot:2
End DoDot:1
+12 DO FTR
+13 QUIT
+14 ;
HDR ; Create Report Header
+1 ;
+2 ;
+3 ; BAR CODE MEDICATION ADMINISTRATION (BCMA) UNKNOWN ACTION STATUS REPORT
+4 ; Date/Time: NOW
+5 ; Date Range: Y1 to Y2 (inculsive)
+6 ;
+7 ;
+8 ; This is a report of entries, created within the given date range, in the
+9 ; BCMA Medication Log File with UNKNOWN Action Status data.
+10 ; These entries may be corrected via the BCMA GUI "Edit Med Log".
+11 ;
+12 ;----------------------------------------------------------------
+13 ;
+14 if $Y>1
WRITE @IOF
+15 if $X>1
WRITE !
+16 SET PSBPG="Page: "_PSBPGNUM_" of "_$SELECT($ORDER(PSBOUTP(""),-1)=0:1,1:$ORDER(PSBOUTP(""),-1))
+17 SET PSBPGRM=IOM-($LENGTH(PSBPG)+5)
+18 IF $PIECE(PSBRPT(0),U,4)=""
SET $PIECE(PSBRPT(0),U,4)=DUZ(2)
+19 SET PSBDIVN="Division: "_$$GET1^DIQ(4,$PIECE(PSBRPT(0),U,4)_",",.01)
+20 WRITE !!,"BCMA UNKNOWN ACTION STATUS REPORT"
WRITE ?PSBPGRM,PSBPG
+21 WRITE !,"Date/Time: "_PSBDTTM,!,"Report Date Range: Start Date: "_Y1_" Stop Date: "_Y2
+22 WRITE !,PSBDIVN,?(IOM-($LENGTH("Total *UNKNOWN* entries found: "_+PSBTOT)+5)),"Total *UNKNOWN* entries found: "_+PSBTOT
+23 WRITE !!,?5,"This is a report of entries, created within the given date range,"
+24 WRITE !,?5,"in the BCMA Medication Log File with UNKNOWN Action Status data."
+25 WRITE !,?5,"These entries can be corrected using the BCMA GUI ""Edit Med Log""."
+26 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","="),!!
+27 ;
+28 QUIT
+29 ;
FTR ; Create Report Footer
+1 ;
+2 IF (IOSL<100)
FOR
if $Y>(IOSL-7)
QUIT
WRITE !
+3 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","="),!
+4 WRITE !,PSBDTTM,!,"BCMA UNKNOWN ACTION STATUS REPORT - footer -"
+5 WRITE ?PSBPGRM,PSBPG,!
+6 QUIT
+7 ;
PGTOT(X) ;Keep track of lines and PAGE Number...
+1 ;
+2 if '$DATA(X)
SET PSBLNTOT=PSBLNTOT+1
+3 if $DATA(X)
SET PSBLNTOT=PSBLNTOT+X
+4 IF PSBPGNUM=1
IF (PSBLNTOT=1)
SET PSBLNTOT=14
SET PSBMORE=PSBLNTOT+12
QUIT PSBPGNUM
+5 IF PSBLNTOT=PSBMORE
Begin DoDot:1
+6 SET PSBMORE=PSBLNTOT+12
+7 IF PSBMORE>(IOSL-7)
SET PSBPGNUM=PSBPGNUM+1
SET PSBLNTOT=14
SET PSBMORE=PSBLNTOT+12
End DoDot:1
+8 QUIT PSBPGNUM
