PSJLOI.m

PSJLOI ;BIR/MV-PRINT ACKNOWLEGED PENDING LABELS ;16 DEC 97 / 9:32 AM 

 ;;5.0; INPATIENT MEDICATIONS ;**28,54**;16 DEC 97

 ;

 ; Reference to ^PS(55 supported by DBIA #2191.

 ; Reference to ^DPT supported by DBIA #10035.

 ; Reference to ^%DTC supported by DBIA #10000.

 ;

 ;Queue MAR labels for Acknowleged pending orders.

EN(DFN,ON)         ;

 N P,X,Y,PSGTOL,PSGUOW,PSGP,PSGTOO,DA

 S PSGP=DFN

 Q:'$D(^DPT(PSGP,.1))  N PSJACPF,PSJACNWP S PSJACPF=11 D ENCV^PSGSETU S Y=DFN D CHK^PSGP Q:'PSJSYSL

 S DA=+ON

 S ND0=^PS(53.1,DA,0)

 S PSGTOL=2,PSGUOW=DUZ,PSGTOO=2

 S X=$P(PSJSYSW0,U,2) I X="" S X=1

 S Y=$P($G(^PS(53.1,DA,8)),U),Y=$S(Y="A":4,Y="H":5,Y="C":6,1:1)

 I X=1!($P(ND0,U,4)'="U"&(X[Y!(Y=1)))!($P(ND0,U,4)="U"&(X=2)) D

 . D NOW^%DTC S PSGDT=% D ENL^PSGVDS

 S ^PS(53.1,DA,7)=PSGDT_U_"N"

 I $P(PSJSYSL,U,2)]"" S PSGOP=DFN D ^PSGLW

 Q

 ;

EN2(DFN,ON)     ;

 N PSGTOL,PSGUOW,PSGP,PSGTOO,DA

 S PSGP=DFN

 Q:'$D(^DPT(PSGP,.1))  N PSJACPF,PSJACNWP S PSJACPF=11 D ENCV^PSGSETU S Y=DFN D CHK^PSGP Q:'PSJSYSL

 S DA=+ON

 S PSGTOL=2,PSGUOW=DUZ,PSGTOO=1

 I +PSJSYSL>1 S $P(^PS(55,PSGP,5,DA,7),U)=PSGDT S:$P(^(7),U,2)="" $P(^(7),U,2)="N"_$S($P(^PS(55,PSGP,5,DA,0),U,24)="E":"E",1:"") S PSGOP=DFN D ^PSGLW

 Q

PSJLOI    ;BIR/MV-PRINT ACKNOWLEGED PENDING LABELS ;16 DEC 97 / 9:32 AM 

 +1       ;;5.0; INPATIENT MEDICATIONS ;**28,54**;16 DEC 97

 +2       ;

 +3       ; Reference to ^PS(55 supported by DBIA #2191.

 +4       ; Reference to ^DPT supported by DBIA #10035.

 +5       ; Reference to ^%DTC supported by DBIA #10000.

 +6       ;

 +7       ;Queue MAR labels for Acknowleged pending orders.

EN(DFN,ON) ;

 +1        NEW P,X,Y,PSGTOL,PSGUOW,PSGP,PSGTOO,DA

 +2        SET PSGP=DFN

 +3        IF '$DATA(^DPT(PSGP,.1))

               QUIT 

           NEW PSJACPF,PSJACNWP

           SET PSJACPF=11

           DO ENCV^PSGSETU

           SET Y=DFN

           DO CHK^PSGP

           IF 'PSJSYSL

               QUIT 

 +4        SET DA=+ON

 +5        SET ND0=^PS(53.1,DA,0)

 +6        SET PSGTOL=2

           SET PSGUOW=DUZ

           SET PSGTOO=2

 +7        SET X=$PIECE(PSJSYSW0,U,2)

           IF X=""

               SET X=1

 +8        SET Y=$PIECE($GET(^PS(53.1,DA,8)),U)

           SET Y=$SELECT(Y="A":4,Y="H":5,Y="C":6,1:1)

 +9        IF X=1!($PIECE(ND0,U,4)'="U"&(X[Y!(Y=1)))!($PIECE(ND0,U,4)="U"&(X=2))

               Begin DoDot:1

 +10               DO NOW^%DTC

                   SET PSGDT=%

                   DO ENL^PSGVDS

               End DoDot:1

 +11       SET ^PS(53.1,DA,7)=PSGDT_U_"N"

 +12       IF $PIECE(PSJSYSL,U,2)]""

               SET PSGOP=DFN

               DO ^PSGLW

 +13       QUIT 

 +14      ;

EN2(DFN,ON) ;

 +1        NEW PSGTOL,PSGUOW,PSGP,PSGTOO,DA

 +2        SET PSGP=DFN

 +3        IF '$DATA(^DPT(PSGP,.1))

               QUIT 

           NEW PSJACPF,PSJACNWP

           SET PSJACPF=11

           DO ENCV^PSGSETU

           SET Y=DFN

           DO CHK^PSGP

           IF 'PSJSYSL

               QUIT 

 +4        SET DA=+ON

 +5        SET PSGTOL=2

           SET PSGUOW=DUZ

           SET PSGTOO=1

 +6        IF +PSJSYSL>1

               SET $PIECE(^PS(55,PSGP,5,DA,7),U)=PSGDT

               IF $PIECE(^(7),U,2)=""

                   SET $PIECE(^(7),U,2)="N"_$SELECT($PIECE(^PS(55,PSGP,5,DA,0),U,24)="E":"E",1:"")

               SET PSGOP=DFN

               DO ^PSGLW

 +7        QUIT 

 +8 

*****   ERRORS & WARNINGS IN PSJLOI   *****

   PSJLOI+1     S - 2nd line of routine violates the SAC.