PSOSUDP2.m

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 ---PSOSUDP2   697     printed  Apr 09, 2024@21:35:54                                                                                                                                                                                                     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