PSJVOSR ;BIR/DRF-PRINT ACTIVE ORDER SCHEDULE VALIDATION ;13 APR 09 / 5:26 PM
;;5.0; INPATIENT MEDICATIONS ;**113**;16 DEC 97;Build 63
;
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to ^%ZTLOAD is supported by DBIA 10063.
; Reference to ^%DTC is supported by DBIA 10000.
; Reference to ^%ZIS is supported by DBIA 10086.
; Reference to ^%ZISC is supported by DBIA 10089.
; Reference to ^DIR is supported by DBIA 10026.
;
SELDEV ;Ask for device type for report to output to
K IOP,%ZIS,POP,IO("Q")
W ! S %ZIS("A")="Select output device: ",%ZIS("B")="",%ZIS="Q"
D ^%ZIS I POP W !,"** No device selected **" G EXIT
W:'$D(IO("Q")) !,"this may take a while...(you should QUEUE this report)",!
I $D(IO("Q")) D G EXIT
. S XDESC="Problem Schedules on Orders"
. S ZTRTN="START^PSJVOSR"
. K IO("Q"),ZTSAVE,ZTDTH,ZTSK
. S ZTDESC=XDESC,PSGIO=ION,ZTIO=PSGIO,ZTDTH=$H,ZTSAVE("PSJSORT")="",%ZIS="QN",IOP=PSGIO
. D ^%ZIS,^%ZTLOAD
;
START ;Loop through open orders.
D NOW^%DTC S UL132="",$P(UL132,"-",132)="",PSJDATE=$$ENDTC^PSGMI(%),PSJPTR=$E(IOST)'="C",PG=0,PSIVAC="PH",PSJPAG=0
U IO
D HEAD
S PSJTYP="U"
S STPDT=$P(%,".")-1 F S STPDT=$O(^PS(55,"AUD",STPDT)) Q:STPDT="" D
. S D0="" F S D0=$O(^PS(55,"AUD",STPDT,D0)) Q:D0="" D
.. S D1="" F S D1=$O(^PS(55,"AUD",STPDT,D0,D1)) Q:D1="" D
... D TEST
S PSJTYP="V"
S STPDT=$P(%,".")-1 F S STPDT=$O(^PS(55,"AIV",STPDT)) Q:STPDT="" D
. S D0="" F S D0=$O(^PS(55,"AIV",STPDT,D0)) Q:D0="" D
.. S D1="" F S D1=$O(^PS(55,"AIV",STPDT,D0,D1)) Q:D1="" D
... D TEST
EXIT ;Kill and exit.
K %,%H,%I,%ZIS,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
K D0,D1,DONE,ERR,NAME,PG,PSGAT,PSGIO,PSGS0XT,PSGSCH,PSGSSP,PSGSST,PSGST
K PSIVAC,PSJDATE,PSJPAG,PSJPTR,PSJTYP,SPD,SSN,STD,STPDT,UL132,X,XDESC,Y
K ZTQUEUED,ZTREQ
W:$E(IOST)="C"&($Y) @IOF
S:$D(ZTQUEUED) ZTREQ="@"
S IOP="HOME" D ^%ZISC
Q
;
DISPLAY ;Display Name, last 4 of SS, order number, start date, stop date, schedule, schedule type, admin times, error.
S NAME=$$GET1^DIQ(2,D0,.01,"O")
S SSN="XXX-XX-"_$E($$GET1^DIQ(2,D0,.09,"O"),6,9)
S Y=PSGSST D DD^%DT S STD=Y
S Y=PSGSSP D DD^%DT S SPD=Y
D:($Y+5)>IOSL HEAD
W !,NAME,?20,SSN,?33,STD,?52,SPD,?71,PSGSCH,?91,$S(+PSGS0XT:"C",1:PSGS0XT),?96,PSGAT,!,ERR
Q
;
PAUSE ;Hold screen.
K DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) DONE=1
Q
;
TEST ;Check for errors.
N D12,MAX
I PSJTYP="U" D
. S D12=$G(^PS(55,D0,5,D1,2))
. S PSGSCH=$P(D12,"^",1),(X,PSGAT)=$P(D12,"^",5),PSGS0XT=$P(D12,"^",6),PSGSST=$P(D12,"^",2),PSGSSP=$P(D12,"^",4)
I PSJTYP="V" D
. S D12=$G(^PS(55,D0,"IV",D1,0))
. S PSGSCH=$P(D12,"^",9),(X,PSGAT)=$P(D12,"^",11),PSGS0XT=$P(D12,"^",15),PSGSST=$P(D12,"^",2),PSGSSP=$P(D12,"^",3)
I PSGSCH[" PRN" S PSGS0XT="P"
I PSGS0XT="P" D Q ;No times required or allowed for PRN
. I X="" Q
. S ERR="Admin times not permitted for PRN schedule"
. D DISPLAY
I PSGS0XT="D"!(PSGS0XT)="OC" Q
S PSGST=$S(PSGS0XT?1.N:"C",1:PSGS0XT)
S ERR="" D
. I X="" S ERR="This order requires at least one administration time" Q
. I $G(PSGS0XT)="O",$L(X,"-")>1 S ERR="This is a One Time Order - only one admin time is permitted." Q
. I +PSGS0XT=0 Q ;No frequency - can not check frequency related items
. S MAX=1440/PSGS0XT
. I MAX<1 D Q
.. I $L(X,"-")'=1 S ERR="This order requires one admin time." Q
. I MAX'<1,$L(X,"-")>MAX S ERR="The number of admin times entered is greater than indicated by the schedule." Q ;Too many times
. I MAX'<1,$L(X,"-")<MAX S ERR="The number of admin times entered is fewer than indicated by the schedule." Q ;Too few times
I ERR]"" D DISPLAY Q
D ENCHK^PSGS0
I '$D(X) S ERR="Schedule/Admin times failed validation" D DISPLAY
Q
;
HEAD ;Header.
W:$Y @IOF S PSJPAG=PSJPAG+1
W PSJDATE,?47,"Inpatient Medications Schedule Issues",?120,"PAGE: ",PSJPAG,!! W !,"PATIENT",?20,"SSN",?33,"START DATE",?52,"STOP DATE",?71,"SCHEDULE",?91,"TYPE",?96,"ADMIN TIMES"
W !,UL132
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJVOSR 3983 printed Sep 23, 2025@19:45:24 Page 2
PSJVOSR ;BIR/DRF-PRINT ACTIVE ORDER SCHEDULE VALIDATION ;13 APR 09 / 5:26 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**113**;16 DEC 97;Build 63
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ; Reference to ^%ZTLOAD is supported by DBIA 10063.
+5 ; Reference to ^%DTC is supported by DBIA 10000.
+6 ; Reference to ^%ZIS is supported by DBIA 10086.
+7 ; Reference to ^%ZISC is supported by DBIA 10089.
+8 ; Reference to ^DIR is supported by DBIA 10026.
+9 ;
SELDEV ;Ask for device type for report to output to
+1 KILL IOP,%ZIS,POP,IO("Q")
+2 WRITE !
SET %ZIS("A")="Select output device: "
SET %ZIS("B")=""
SET %ZIS="Q"
+3 DO ^%ZIS
IF POP
WRITE !,"** No device selected **"
GOTO EXIT
+4 if '$DATA(IO("Q"))
WRITE !,"this may take a while...(you should QUEUE this report)",!
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET XDESC="Problem Schedules on Orders"
+7 SET ZTRTN="START^PSJVOSR"
+8 KILL IO("Q"),ZTSAVE,ZTDTH,ZTSK
+9 SET ZTDESC=XDESC
SET PSGIO=ION
SET ZTIO=PSGIO
SET ZTDTH=$HOROLOG
SET ZTSAVE("PSJSORT")=""
SET %ZIS="QN"
SET IOP=PSGIO
+10 DO ^%ZIS
DO ^%ZTLOAD
End DoDot:1
GOTO EXIT
+11 ;
START ;Loop through open orders.
+1 DO NOW^%DTC
SET UL132=""
SET $PIECE(UL132,"-",132)=""
SET PSJDATE=$$ENDTC^PSGMI(%)
SET PSJPTR=$EXTRACT(IOST)'="C"
SET PG=0
SET PSIVAC="PH"
SET PSJPAG=0
+2 USE IO
+3 DO HEAD
+4 SET PSJTYP="U"
+5 SET STPDT=$PIECE(%,".")-1
FOR
SET STPDT=$ORDER(^PS(55,"AUD",STPDT))
if STPDT=""
QUIT
Begin DoDot:1
+6 SET D0=""
FOR
SET D0=$ORDER(^PS(55,"AUD",STPDT,D0))
if D0=""
QUIT
Begin DoDot:2
+7 SET D1=""
FOR
SET D1=$ORDER(^PS(55,"AUD",STPDT,D0,D1))
if D1=""
QUIT
Begin DoDot:3
+8 DO TEST
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET PSJTYP="V"
+10 SET STPDT=$PIECE(%,".")-1
FOR
SET STPDT=$ORDER(^PS(55,"AIV",STPDT))
if STPDT=""
QUIT
Begin DoDot:1
+11 SET D0=""
FOR
SET D0=$ORDER(^PS(55,"AIV",STPDT,D0))
if D0=""
QUIT
Begin DoDot:2
+12 SET D1=""
FOR
SET D1=$ORDER(^PS(55,"AIV",STPDT,D0,D1))
if D1=""
QUIT
Begin DoDot:3
+13 DO TEST
End DoDot:3
End DoDot:2
End DoDot:1
EXIT ;Kill and exit.
+1 KILL %,%H,%I,%ZIS,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
+2 KILL D0,D1,DONE,ERR,NAME,PG,PSGAT,PSGIO,PSGS0XT,PSGSCH,PSGSSP,PSGSST,PSGST
+3 KILL PSIVAC,PSJDATE,PSJPAG,PSJPTR,PSJTYP,SPD,SSN,STD,STPDT,UL132,X,XDESC,Y
+4 KILL ZTQUEUED,ZTREQ
+5 if $EXTRACT(IOST)="C"&($Y)
WRITE @IOF
+6 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 SET IOP="HOME"
DO ^%ZISC
+8 QUIT
+9 ;
DISPLAY ;Display Name, last 4 of SS, order number, start date, stop date, schedule, schedule type, admin times, error.
+1 SET NAME=$$GET1^DIQ(2,D0,.01,"O")
+2 SET SSN="XXX-XX-"_$EXTRACT($$GET1^DIQ(2,D0,.09,"O"),6,9)
+3 SET Y=PSGSST
DO DD^%DT
SET STD=Y
+4 SET Y=PSGSSP
DO DD^%DT
SET SPD=Y
+5 if ($Y+5)>IOSL
DO HEAD
+6 WRITE !,NAME,?20,SSN,?33,STD,?52,SPD,?71,PSGSCH,?91,$SELECT(+PSGS0XT:"C",1:PSGS0XT),?96,PSGAT,!,ERR
+7 QUIT
+8 ;
PAUSE ;Hold screen.
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET DONE=1
+2 QUIT
+3 ;
TEST ;Check for errors.
+1 NEW D12,MAX
+2 IF PSJTYP="U"
Begin DoDot:1
+3 SET D12=$GET(^PS(55,D0,5,D1,2))
+4 SET PSGSCH=$PIECE(D12,"^",1)
SET (X,PSGAT)=$PIECE(D12,"^",5)
SET PSGS0XT=$PIECE(D12,"^",6)
SET PSGSST=$PIECE(D12,"^",2)
SET PSGSSP=$PIECE(D12,"^",4)
End DoDot:1
+5 IF PSJTYP="V"
Begin DoDot:1
+6 SET D12=$GET(^PS(55,D0,"IV",D1,0))
+7 SET PSGSCH=$PIECE(D12,"^",9)
SET (X,PSGAT)=$PIECE(D12,"^",11)
SET PSGS0XT=$PIECE(D12,"^",15)
SET PSGSST=$PIECE(D12,"^",2)
SET PSGSSP=$PIECE(D12,"^",3)
End DoDot:1
+8 IF PSGSCH[" PRN"
SET PSGS0XT="P"
+9 ;No times required or allowed for PRN
IF PSGS0XT="P"
Begin DoDot:1
+10 IF X=""
QUIT
+11 SET ERR="Admin times not permitted for PRN schedule"
+12 DO DISPLAY
End DoDot:1
QUIT
+13 IF PSGS0XT="D"!(PSGS0XT)="OC"
QUIT
+14 SET PSGST=$SELECT(PSGS0XT?1.N:"C",1:PSGS0XT)
+15 SET ERR=""
Begin DoDot:1
+16 IF X=""
SET ERR="This order requires at least one administration time"
QUIT
+17 IF $GET(PSGS0XT)="O"
IF $LENGTH(X,"-")>1
SET ERR="This is a One Time Order - only one admin time is permitted."
QUIT
+18 ;No frequency - can not check frequency related items
IF +PSGS0XT=0
QUIT
+19 SET MAX=1440/PSGS0XT
+20 IF MAX<1
Begin DoDot:2
+21 IF $LENGTH(X,"-")'=1
SET ERR="This order requires one admin time."
QUIT
End DoDot:2
QUIT
+22 ;Too many times
IF MAX'<1
IF $LENGTH(X,"-")>MAX
SET ERR="The number of admin times entered is greater than indicated by the schedule."
QUIT
+23 ;Too few times
IF MAX'<1
IF $LENGTH(X,"-")<MAX
SET ERR="The number of admin times entered is fewer than indicated by the schedule."
QUIT
End DoDot:1
+24 IF ERR]""
DO DISPLAY
QUIT
+25 DO ENCHK^PSGS0
+26 IF '$DATA(X)
SET ERR="Schedule/Admin times failed validation"
DO DISPLAY
+27 QUIT
+28 ;
HEAD ;Header.
+1 if $Y
WRITE @IOF
SET PSJPAG=PSJPAG+1
+2 WRITE PSJDATE,?47,"Inpatient Medications Schedule Issues",?120,"PAGE: ",PSJPAG,!!
WRITE !,"PATIENT",?20,"SSN",?33,"START DATE",?52,"STOP DATE",?71,"SCHEDULE",?91,"TYPE",?96,"ADMIN TIMES"
+3 WRITE !,UL132
+4 QUIT
