PSJMPRTU.m

PSJMPRTU ;BIR/MV-SETUP AND PRINT UD ORDER ;25 NOV 96 / 1:34 PM

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

START ;

 S (PPN1,PSJATME1,PID1,PSGWN1,PRB1,TM1)=""

 N SP S $P(SP," ",20)=" " S:ON["*" PSJATMEO=0

 D NEWPG

 Q

NEWPG ;

 I PSJADT'=PSJADTO S:($E(PSJADT,1,2)="99") PSJHL3="PRN orders for: "_XNAME S:($E(PSJADT,1,2)="88") PSJHL3="*** No admin time could be calculated for the following orders: ***" D SETALL,@PSGSS Q

 I PSJLN+PSJNEED>$S($E(IOST)="E":23,1:60) D SETALL,@PSGSS Q

 D @PSGSS

 Q

SETALL ;

 S (PSJADTO,PSJADT1)=PSJADT,(PPNO,PPN1)=PPN,(PSJATMEO,PSJATME1)=PSJATME,(PRBO,PRB1)=PRB S:PSJATME1]"88" PSJATME1="     "

 S PID1=PID,PSGWN1=PSGWN

 S TMO=TM

 S:$G(PSGTM)!$G(PSGTMALL) TM1=$S(TM="ZZ":"NOT FOUND",1:TM),PSJHL1=$P(PSJHL1,", ")_", "_TM1

 S PSJLN=66

 Q

P ;

 D:(PSJLN+PSJNEED)>PSJTOTLN SETALL

 D:PPN'=PPNO SETALL

 S:PSJATME'=PSJATMEO (PSJATMEO,PSJATME1)=PSJATME

 S:PSJATME1["99" PSJATME1="     " S:PSJATME1["88" PSJATME1="     "

 D SETPVAR,PSJPRT($P(PPN1,U),PRB1,PSJATME1,PID1,"","",PSGWN1,"","")

 Q

G ;

W ;

 D:(PSJLN+PSJNEED)>PSJTOTLN SETALL

 D:TM'=TMO SETALL

 S:PSJATME'=PSJATMEO (PSJATMEO,PSJATME1)=PSJATME

 S:PRB'=PRBO (PRBO,PRB1)=PRB

 S:PPN'=PPNO (PPNO,PPN1)=PPN,PID1=PID,PSGWN1=PSGWN,PRB1=PRB

 D SETPVAR

 D:PSGRBADM="A" PSJPRT(PSJATME1,PRB1,PPN1,"     ",$E(SP,1,11),PID1,"     ",$E(SP,1,11),PSGWN1)

 D:PSGRBADM="P" PSJPRT($P(PPN1,U),PRB1,PSJATME1,PID1,"","",PSGWN1,"","")

 D:PSGRBADM="R" PSJPRT(PRB1,PPN1,PSJATME1,$E(SP,1,11),PID1,"     ",$E(SP,1,11),PSGWN1,"     ")

 Q

 ;

PSJPRT(C1,C2,C3,C4,C5,C6,C7,C8,C9)     ;

 S PSJPRT(1)=C1_" "_C2_" "_C3

 S PSJPRT(2)=C4_" "_C5_" "_C6

 S PSJPRT(3)=C7_" "_C8_" "_C9

 Q

SETPVAR ;

 S PPN1=$E($P(PPN1,U)_SP,1,20),PID1=$E(PID1_SP,1,20)

 S PRB1=$E(PRB1_SP,1,11),PSGWN1=$E(PSGWN1_SP,1,20)

 S X=PSJATME1 I ON["*" S PSJATME1="*    " Q

 S:X>0 X=$S($L(X)=3:"0"_X,1:X),X=$E(X,1,2)_":"_$E(X,3,4)

 S PSJATME1=$E(X_SP,1,5)

 Q

PRT ;

 D:(PSJLN+PSJNEED)>PSJTOTLN HDR Q:$G(PSJSTOP)

 W !,PSJPRT(1),?39,PSGLOD," | "

 I QST["Z" W "P E N D I N G"

 E  W PSGLSD," | ",PSGLFD

 NEW X,MARX

 D DRGDISP^PSJLMUT1(PSGP,+ON_$S(QST["Z":"P",1:"U"),41,35,.MARX,0)

 NEW X F X=0:0 S X=$O(MARX(X)) Q:'X   W !,$G(PSJPRT(X+1)) W ?39,MARX(X)

 I PSJSI]"" W !?39 F Y=1:1:$L(PSJSI," ") S Y1=$P(PSJSI," ",Y) W:($L(Y1)+$X)>79 !?39 W Y1_" "

 W:PSJHOLD !?39,"*** ON HOLD ***"

 W:PSJONETM !?39,"*** ONE TIME ***"

 W:PSJONCAL !?39,"*** ON CALL ***"

 W !?39,"RN/LPN Init: ________"

 W !

 S PSJLN=PSJLN+PSJNEED

 Q

HDR ;

 I PSGPG,$G(PSJASTR) S X=$Y D

 . F X=X:1:PSJTOTLN W !

 . W PSJHL62 S PSJASTR=0

 Q:$$PRTCHK^PSJMUTL(PSGPG)

 W:($E(IOST)="C"!PSGPG)&($Y) @IOF

 S PSJLN=5,PSGPG=PSGPG+1

 W !,PSJHL1,?66,"Page: ",PSGPG,!,PSJHL2

 W:$E(PSJADT,1,2)="88" ! W !,PSJHL3,!

 I ((PSJADT1'["9999")&(PSJADT1'["8888")) W !,"For date: ",$E($$ENDTC^PSGMI(PSJADT1),1,8),!

 Q

PSJMPRTU  ;BIR/MV-SETUP AND PRINT UD ORDER ;25 NOV 96 / 1:34 PM

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

START     ;

 +1        SET (PPN1,PSJATME1,PID1,PSGWN1,PRB1,TM1)=""

 +2        NEW SP

           SET $PIECE(SP," ",20)=" "

           IF ON["*"

               SET PSJATMEO=0

 +3        DO NEWPG

 +4        QUIT 

NEWPG     ;

 +1        IF PSJADT'=PSJADTO

               IF ($EXTRACT(PSJADT,1,2)="99")

                   SET PSJHL3="PRN orders for: "_XNAME

               IF ($EXTRACT(PSJADT,1,2)="88")

                   SET PSJHL3="*** No admin time could be calculated for the following orders: ***"

               DO SETALL

               DO @PSGSS

               QUIT 

 +2        IF PSJLN+PSJNEED>$SELECT($EXTRACT(IOST)="E":23,1:60)

               DO SETALL

               DO @PSGSS

               QUIT 

 +3        DO @PSGSS

 +4        QUIT 

SETALL    ;

 +1        SET (PSJADTO,PSJADT1)=PSJADT

           SET (PPNO,PPN1)=PPN

           SET (PSJATMEO,PSJATME1)=PSJATME

           SET (PRBO,PRB1)=PRB

           IF PSJATME1]"88"

               SET PSJATME1="     "

 +2        SET PID1=PID

           SET PSGWN1=PSGWN

 +3        SET TMO=TM

 +4        IF $GET(PSGTM)!$GET(PSGTMALL)

               SET TM1=$SELECT(TM="ZZ":"NOT FOUND",1:TM)

               SET PSJHL1=$PIECE(PSJHL1,", ")_", "_TM1

 +5        SET PSJLN=66

 +6        QUIT 

P         ;

 +1        IF (PSJLN+PSJNEED)>PSJTOTLN

               DO SETALL

 +2        IF PPN'=PPNO

               DO SETALL

 +3        IF PSJATME'=PSJATMEO

               SET (PSJATMEO,PSJATME1)=PSJATME

 +4        IF PSJATME1["99"

               SET PSJATME1="     "

           IF PSJATME1["88"

               SET PSJATME1="     "

 +5        DO SETPVAR

           DO PSJPRT($PIECE(PPN1,U),PRB1,PSJATME1,PID1,"","",PSGWN1,"","")

 +6        QUIT 

G         ;

W         ;

 +1        IF (PSJLN+PSJNEED)>PSJTOTLN

               DO SETALL

 +2        IF TM'=TMO

               DO SETALL

 +3        IF PSJATME'=PSJATMEO

               SET (PSJATMEO,PSJATME1)=PSJATME

 +4        IF PRB'=PRBO

               SET (PRBO,PRB1)=PRB

 +5        IF PPN'=PPNO

               SET (PPNO,PPN1)=PPN

               SET PID1=PID

               SET PSGWN1=PSGWN

               SET PRB1=PRB

 +6        DO SETPVAR

 +7        IF PSGRBADM="A"

               DO PSJPRT(PSJATME1,PRB1,PPN1,"     ",$EXTRACT(SP,1,11),PID1,"     ",$EXTRACT(SP,1,11),PSGWN1)

 +8        IF PSGRBADM="P"

               DO PSJPRT($PIECE(PPN1,U),PRB1,PSJATME1,PID1,"","",PSGWN1,"","")

 +9        IF PSGRBADM="R"

               DO PSJPRT(PRB1,PPN1,PSJATME1,$EXTRACT(SP,1,11),PID1,"     ",$EXTRACT(SP,1,11),PSGWN1,"     ")

 +10       QUIT 

 +11      ;

PSJPRT(C1,C2,C3,C4,C5,C6,C7,C8,C9) ;

 +1        SET PSJPRT(1)=C1_" "_C2_" "_C3

 +2        SET PSJPRT(2)=C4_" "_C5_" "_C6

 +3        SET PSJPRT(3)=C7_" "_C8_" "_C9

 +4        QUIT 

SETPVAR   ;

 +1        SET PPN1=$EXTRACT($PIECE(PPN1,U)_SP,1,20)

           SET PID1=$EXTRACT(PID1_SP,1,20)

 +2        SET PRB1=$EXTRACT(PRB1_SP,1,11)

           SET PSGWN1=$EXTRACT(PSGWN1_SP,1,20)

 +3        SET X=PSJATME1

           IF ON["*"

               SET PSJATME1="*    "

               QUIT 

 +4        IF X>0

               SET X=$SELECT($LENGTH(X)=3:"0"_X,1:X)

               SET X=$EXTRACT(X,1,2)_":"_$EXTRACT(X,3,4)

 +5        SET PSJATME1=$EXTRACT(X_SP,1,5)

 +6        QUIT 

PRT       ;

 +1        IF (PSJLN+PSJNEED)>PSJTOTLN

               DO HDR

           IF $GET(PSJSTOP)

               QUIT 

 +2        WRITE !,PSJPRT(1),?39,PSGLOD," | "

 +3        IF QST["Z"

               WRITE "P E N D I N G"

 +4       IF '$TEST

               WRITE PSGLSD," | ",PSGLFD

 +5        NEW X,MARX

 +6        DO DRGDISP^PSJLMUT1(PSGP,+ON_$SELECT(QST["Z":"P",1:"U"),41,35,.MARX,0)

 +7        NEW X

           FOR X=0:0

               SET X=$ORDER(MARX(X))

               IF 'X

                   QUIT 

               WRITE !,$GET(PSJPRT(X+1))

               WRITE ?39,MARX(X)

 +8        IF PSJSI]""

               WRITE !?39

               FOR Y=1:1:$LENGTH(PSJSI," ")

                   SET Y1=$PIECE(PSJSI," ",Y)

                   IF ($LENGTH(Y1)+$X)>79

                       WRITE !?39

                   WRITE Y1_" "

 +9        IF PSJHOLD

               WRITE !?39,"*** ON HOLD ***"

 +10       IF PSJONETM

               WRITE !?39,"*** ONE TIME ***"

 +11       IF PSJONCAL

               WRITE !?39,"*** ON CALL ***"

 +12       WRITE !?39,"RN/LPN Init: ________"

 +13       WRITE !

 +14       SET PSJLN=PSJLN+PSJNEED

 +15       QUIT 

HDR       ;

 +1        IF PSGPG

               IF $GET(PSJASTR)

                   SET X=$Y

                   Begin DoDot:1

 +2                    FOR X=X:1:PSJTOTLN

                           WRITE !

 +3                    WRITE PSJHL62

                       SET PSJASTR=0

                   End DoDot:1

 +4        IF $$PRTCHK^PSJMUTL(PSGPG)

               QUIT 

 +5        IF ($EXTRACT(IOST)="C"!PSGPG)&($Y)

               WRITE @IOF

 +6        SET PSJLN=5

           SET PSGPG=PSGPG+1

 +7        WRITE !,PSJHL1,?66,"Page: ",PSGPG,!,PSJHL2

 +8        IF $EXTRACT(PSJADT,1,2)="88"

               WRITE !

           WRITE !,PSJHL3,!

 +9        IF ((PSJADT1'["9999")&(PSJADT1'["8888"))

               WRITE !,"For date: ",$EXTRACT($$ENDTC^PSGMI(PSJADT1),1,8),!

 +10       QUIT