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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJMPRTU 2839 printed Nov 22, 2024@17:17:53 Page 2
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
