PSOSUDP2 ;BHAM ISC/RTR-Delete printed batched cont. ; 1/10/96
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
;
BEG G:'$D(^UTILITY($J,"PSODEPT")) END
F PSAA=0:0 S PSAA=$O(^UTILITY($J,"PSODEPT",PSAA)) Q:'PSAA F PSBB=0:0 S PSBB=$O(^UTILITY($J,"PSODEPT",PSAA,PSBB)) Q:'PSBB F PSCC=0:0 S PSCC=$O(^UTILITY($J,"PSODEPT",PSAA,PSBB,PSCC)) Q:'PSCC D
.F PSDD=0:0 S PSDD=$O(^PS(52.5,"AS",PSAA,PSBB,PSCC,PSDD)) Q:'PSDD F PSEE=0:0 S PSEE=$O(^PS(52.5,"AS",PSAA,PSBB,PSCC,PSDD,PSEE)) Q:'PSEE D:$D(^PS(52.5,PSEE,0))&($P($G(^(0)),"^"))
..S PSOIEN=+$P($G(^PS(52.5,PSEE,0)),"^") S DA=PSEE,DIK="^PS(52.5," D ^DIK
END K ^UTILITY($J,"PSODEPT"),PSAA,PSBB,PSCC,PSDD,PSEE,PSOIEN D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSUDP2 697 printed Dec 13, 2024@02:35:25 Page 2
PSOSUDP2 ;BHAM ISC/RTR-Delete printed batched cont. ; 1/10/96
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
+2 ;
BEG if '$DATA(^UTILITY($JOB,"PSODEPT"))
GOTO END
+1 FOR PSAA=0:0
SET PSAA=$ORDER(^UTILITY($JOB,"PSODEPT",PSAA))
if 'PSAA
QUIT
FOR PSBB=0:0
SET PSBB=$ORDER(^UTILITY($JOB,"PSODEPT",PSAA,PSBB))
if 'PSBB
QUIT
FOR PSCC=0:0
SET PSCC=$ORDER(^UTILITY($JOB,"PSODEPT",PSAA,PSBB,PSCC))
if 'PSCC
QUIT
Begin DoDot:1
+2 FOR PSDD=0:0
SET PSDD=$ORDER(^PS(52.5,"AS",PSAA,PSBB,PSCC,PSDD))
if 'PSDD
QUIT
FOR PSEE=0:0
SET PSEE=$ORDER(^PS(52.5,"AS",PSAA,PSBB,PSCC,PSDD,PSEE))
if 'PSEE
QUIT
if $DATA(^PS(52.5,PSEE,0))&($PIECE($GET(^(0)),"^"))
Begin DoDot:2
+3 SET PSOIEN=+$PIECE($GET(^PS(52.5,PSEE,0)),"^")
SET DA=PSEE
SET DIK="^PS(52.5,"
DO ^DIK
End DoDot:2
End DoDot:1
END KILL ^UTILITY($JOB,"PSODEPT"),PSAA,PSBB,PSCC,PSDD,PSEE,PSOIEN
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
