PSGLW.m

PSGLW ;BIR/CML3-LABEL QUEUE AND WRITE ;12 JUN 96 / 2:30 PM

 ;;5.0; INPATIENT MEDICATIONS ;**115**;16 DEC 97

 ;

ENQL ;

 Q:$G(PSGOP)'>0

 I '$G(PSJSYSW0) S PSJSYSW0=+$O(^PS(59.6,"B",$S($G(PSJPWD):$G(PSJPWD),1:+$G(PSGLWD)),0))

 I $S($D(IO)[0:1,1:$P(PSJSYSL,"^",3)'=IO) S IOP=$P(PSJSYSL,"^",2)_";132",%ZIS="NQ" D ^%ZIS K IOP,POP,ZTSAVE S PSGTID=$H,PSGTIR="ENLP^PSGLW",ZTDESC="MAR LABEL PRINT",ZTSAVE("PSGOP")="" D ENTSK^PSGTI K ZTSK Q

 F  S IOP=$P(PSJSYSL,"^",2)_";132",%ZIS="" D ^%ZIS Q:'POP

 ;

ENLP ;

 K PSGLSTOP D ^PSGLPI,NOW^%DTC N PSJFIRST S PSJFIRST=1 S PSGDT=% U IO

 F PSGLWP1=1,2,3 F PSGLWP2=0:0 S PSGLWP2=$O(^PS(53.41,2,1,DUZ,1,PSGOP,1,PSGLWP1,1,PSGLWP2)) Q:'PSGLWP2  D

 . I PSJFIRST,$P(PSJSYSW0,U,18) D ENHEDER^PSGLPI S PSJFIRST=0

 . S PSGORD=PSGLWP2_$E("ANV",PSGLWP1) NEW PSJFLUID

 . I PSGLWP1=2,($P($G(^PS(53.1,+PSGORD,0)),U,9)="P") S PSGORD=+PSGORD_"P" S:$P(^(0),U,4)="F" PSJFLUID=1

 . D @$S((PSGLWP1=3!$G(PSJFLUID)):"EN^PSIVUDL(PSGOP,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB)",1:"^PSGLOI")

 . K ^PS(53.41,2,1,DUZ,1,PSGOP,1,PSGLWP1,1,PSGLWP2)

 K ^PS(53.41,2,1,DUZ,1,PSGOP) D ^%ZISC

 Q

PSGLW     ;BIR/CML3-LABEL QUEUE AND WRITE ;12 JUN 96 / 2:30 PM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**115**;16 DEC 97

 +2       ;

ENQL      ;

 +1        IF $GET(PSGOP)'>0

               QUIT 

 +2        IF '$GET(PSJSYSW0)

               SET PSJSYSW0=+$ORDER(^PS(59.6,"B",$SELECT($GET(PSJPWD):$GET(PSJPWD),1:+$GET(PSGLWD)),0))

 +3        IF $SELECT($DATA(IO)[0:1,1:$PIECE(PSJSYSL,"^",3)'=IO)

               SET IOP=$PIECE(PSJSYSL,"^",2)_";132"

               SET %ZIS="NQ"

               DO ^%ZIS

               KILL IOP,POP,ZTSAVE

               SET PSGTID=$HOROLOG

               SET PSGTIR="ENLP^PSGLW"

               SET ZTDESC="MAR LABEL PRINT"

               SET ZTSAVE("PSGOP")=""

               DO ENTSK^PSGTI

               KILL ZTSK

               QUIT 

 +4        FOR 

               SET IOP=$PIECE(PSJSYSL,"^",2)_";132"

               SET %ZIS=""

               DO ^%ZIS

               IF 'POP

                   QUIT 

 +5       ;

ENLP      ;

 +1        KILL PSGLSTOP

           DO ^PSGLPI

           DO NOW^%DTC

           NEW PSJFIRST

           SET PSJFIRST=1

           SET PSGDT=%

           USE IO

 +2        FOR PSGLWP1=1,2,3

               FOR PSGLWP2=0:0

                   SET PSGLWP2=$ORDER(^PS(53.41,2,1,DUZ,1,PSGOP,1,PSGLWP1,1,PSGLWP2))

                   IF 'PSGLWP2

                       QUIT 

                   Begin DoDot:1

 +3                    IF PSJFIRST

                           IF $PIECE(PSJSYSW0,U,18)

                               DO ENHEDER^PSGLPI

                               SET PSJFIRST=0

 +4                    SET PSGORD=PSGLWP2_$EXTRACT("ANV",PSGLWP1)

                       NEW PSJFLUID

 +5                    IF PSGLWP1=2

                           IF ($PIECE($GET(^PS(53.1,+PSGORD,0)),U,9)="P")

                               SET PSGORD=+PSGORD_"P"

                               IF $PIECE(^(0),U,4)="F"

                                   SET PSJFLUID=1

 +6                    DO @$SELECT((PSGLWP1=3!$GET(PSJFLUID)):"EN^PSIVUDL(PSGOP,PSGORD,PSGLWD_U_PSGLWDN,PSGLRB)",1:"^PSGLOI")

 +7                    KILL ^PS(53.41,2,1,DUZ,1,PSGOP,1,PSGLWP1,1,PSGLWP2)

                   End DoDot:1

 +8        KILL ^PS(53.41,2,1,DUZ,1,PSGOP)

           DO ^%ZISC

 +9        QUIT