PSJINVW.m

PSJINVW ;BIR/CML3-INSTRUCTION HISTORY ;17 SEP 97 /  1:41 PM

 ;;5.0;INPATIENT MEDICATIONS;**267,275**;16 DEC 97;Build 157

 ;

 ; Reference to ^PS(50.7 is supported by DBIA# 2180.

 ; Reference to ^PS(51.2 is supported by DBIA# 2178.

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

 ;

EN0(PSJINHIS,PSJCHTO) ;

 N PNM,PSJFULL S PSJFULL=20

 D EN2 Q

 Q

EN2 ;

 I PSGORD=+PSGORD N PSGO,PSGO1 S PSGO=PSGORD,PSGO1=0 F  S PSGO1=$O(^PS(53.1,"ACX",PSGO,PSGO1)) Q:'PSGO1  Q:$G(PSGOEA)["^"  S PSGORD=PSGO1_"P" D  S PSGORD=""

 . D EN21 K CONT D  Q:$G(PSGOEA)["^"

 .. W !!,"Press RETURN to continue or '^' to exit: " S PN=$G(PN)+2 R CONT:DTIME W @IOF S:CONT["^" PSGOEA="^",PSGPR=1,PSJPR=1

 I PSGORD="" S PSGOEA="^" Q

EN21 ;

 N PSIVFLG S PSIVFLG=0 I PSGORD["P" S PSIVFLG=$P(^PS(53.1,+PSGORD,0),"^",4) S PSIVFLG=$S(PSIVFLG="F":1,PSIVFLG="I":1,1:0)

 S NF=$S(PSGORD["P":1,PSGORD["N":1,1:0)

 S (FL,Y)="",$P(FL,"-",71)="",F="^PS("_$S(NF:"53.1,",(PSGORD["V"):"55,"_PSGP_",""IV"",",1:"55,"_PSGP_",5,")_+PSGORD_","

 S PNM=$G(PSGP(0)) S:PNM="" PNM=$P($G(^DPT(PSGP,0)),"^")

 Q:($G(@(F_"0)"))="")

 I $G(PSJINHIS) D PSJINHIS(1,.PSJCHTO) Q

DONE ;

 K AND,D,DRG1,DRG2,AT,DO,DRG,EB,F,FD,FL,HSM,INS,LID,MR,ND4,OD,PN,PR,PSGID,PSGOD,R,SCH,SCT,SI,SIG,SM,ST,STD,UD,X,XU,Y,DONE,NF, Q

 Q

 ;

PSJINHIS(PSJINHIS,PSJCHTO) ;

 I '$G(PSJHDRF) S PSJHDRF=1 N DASH S $P(DASH,"-",75)="-" D

 .I $E(IOST)="C" D FULL^VALM1 W @IOF

 .W !?25,"Instructions History",!,DASH S PN=$G(PN)+2

 N AND,AND2,PX S PX=""

 N INDENT1,INDENT2 S INDENT1=2,INDENT2=5

 I '$G(PSJPRCOM) D GETPRCOM Q:($G(PX)["^")

 D ENA Q:($G(PX)["^")

 Q:$G(PSJCHTO)=2

 I $G(PSGORD)["V"!$G(PSIVFLG) D PSGOPI Q

 D PSGSI

 Q

 ;

PSGSI ;

 N SI,Q,QQ,QQQ S SI=$S(($G(PSGORD)["P"):$P($G(^PS(53.1,+PSGORD,6)),"^"),($G(PSGORD)["U"):$P($G(^PS(55,PSGP,5,+PSGORD,6)),"^"),1:"")

 N SIL S SIL=$$GETSIOPI^PSJBCMA5(PSGP,PSGORD,1) I SIL!(SI]"") D

 .Q:($G(PX)["^")

 .I '$G(PSJCHTO) N PSJUDGL,PSJUDPH S PSJUDGL=$S($G(PSGORD)["P":"^PS(53.1,+PSGORD,",$G(PSGORD)["U":"^PS(55,PSGP,5,+PSGORD,",1:"") D

 ..I '$G(AND) N AND S AND=$P(@(PSJUDGL_"0)"),"^",16) S PSJUDPH=@(PSJUDGL_"4)") S $P(AND,"^",2)=$S($P(PSJUDPH,"^",3):$P(PSJUDPH,"^",3),$P(PSJUDPH,"^",7):$P(PSJUDPH,"^",7),1:"")

 ..D:$G(PN)>PSJFULL NPAGE W !!,"Date: ",$$ENDTC^PSGMI(+AND) S PN=$G(PN)+3 W ?28,"User: ",$$ENNPN^PSGMI($P(AND,"^",2)),!?INDENT1,"SPECIAL INSTRUCTIONS changed" D

 ...W !?INDENT1,"From: ''",! S PSJCHTO=1 S PN=$G(PN)+2

 .I SI]"",'SIL W !?INDENT1,"To:",!?INDENT2 S PSJCHTO=2,PN=$G(PN)+2 D  Q

 ..S QQQ="" F Q=1:1:$L(SI," ") S QQ=$P(SI," ",Q) W:($L(QQQ_" "_QQ)>72) ! W QQ," " S:($L(QQQ_" "_QQ)>72) QQQ="" S QQQ=QQQ_" "_QQ

 .I $G(PSJCHTO)=2,$D(TMPTO(DFN,1)) W !?INDENT1,"From: " S PSJCHTO=1,PN=$G(PN)+1 N TMPTOLN S TMPTOLN=0 F  S TMPTOLN=$O(TMPTO(DFN,TMPTOLN)) Q:'TMPTOLN!(PX["^")  W !?INDENT2,TMPTO(DFN,TMPTOLN) S PN=PN+1 D:($G(PN)>PSJFULL) NPAGE

 .Q:'$G(PSJSYSP)  N LNTXT S LNTXT=0 F  S LNTXT=$O(^TMP("PSJBCMA5",$J,PSGP,PSGORD,LNTXT)) Q:'LNTXT  D

 ..I LNTXT=1 W !?INDENT1,"To:" S PSJCHTO=2 S PN=$G(PN)+1

 ..W !?INDENT2,$G(^TMP("PSJBCMA5",$J,PSGP,PSGORD,LNTXT)) S PN=$G(PN)+1 K:LNTXT=1 TMPTO S TMPTO(DFN,LNTXT)=^(LNTXT)

 Q

 ;

PSGOPI ;

 N DT,USR,TXTLN,POPIL,POPI S POPI=$S($G(PSGORD)["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,3)),"^"),$G(PSGORD)["P":$P($G(^PS(53.1,+PSGORD,9)),"^",2),1:"")

 S POPIL=$$GETSIOPI^PSJBCMA5(PSGP,PSGORD,1) I POPIL!(POPI]"") D

 .Q:($G(PX)["^")

 .I '$G(PSJCHTO) S $P(AND,"^")=$S(PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,2,1)),"^"),PSGORD["P":$P($G(^PS(53.1,+PSGORD,0)),"^",16),1:"") D

 ..S $P(AND,"^",2)=$S(PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,4)),"^",4),PSGORD["P":$P($G(^PS(53.1,+PSGORD,4)),"^",7),1:"")

 ..D:($G(PN)>PSJFULL) NPAGE W !!,"Date: ",$$ENDTC^PSGMI(+AND) S PN=$G(PN)+2 W ?28,"User: ",$$ENNPN^PSGMI($P(AND,"^",2)),!,"OTHER PRINT INFO changed" D

 ...W !?INDENT1,"From: ",!?INDENT2,"""""",! S PSJCHTO=1 S PN=$G(PN)+4

 .I $G(PSJCHTO)=2,$D(TMPTO(DFN,1)) W !?INDENT1,"From: " S PSJCHTO=1,PN=$G(PN)+1 N TMPTOLN S TMPTOLN=0 F  S TMPTOLN=$O(TMPTO(DFN,TMPTOLN)) Q:'TMPTOLN!(PX["^")  W !?INDENT2,TMPTO(DFN,TMPTOLN) S PN=PN+1 D:($G(PN)>PSJFULL) NPAGE

 .S TXTLN=0 F  S TXTLN=$O(^TMP("PSJBCMA5",$J,PSGP,PSGORD,TXTLN)) Q:'TXTLN!($G(PX)["^")  D

 ..I (TXTLN=1) W !?INDENT1,"To:" S PN=$G(PN)+1

 ..W !?INDENT2,^TMP("PSJBCMA5",$J,PSGP,PSGORD,TXTLN) S PN=$G(PN)+1,PSJCHTO=2 K:TXTLN=1 TMPTO S TMPTO(DFN,TXTLN)=^(TXTLN) D:($G(PN)>PSJFULL) NPAGE

 Q

ENA ;

 I PSGORD["U" F Q=0:0 S Q=$O(^PS(55,PSGP,5,+PSGORD,9,Q)) Q:'Q!(PX["^")  I $D(^(Q,0)) S AND=^(0) D:($G(PN)>PSJFULL) NPAGE Q:PX["^"  D AL1

 I PSGORD["P" F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,"A",Q)) Q:'Q!(PX["^")  I $D(^(Q,0)) S AND=^(0) D:($G(PN)>PSJFULL) NPAGE Q:PX["^"  D AL1

 I PSGORD["V" S Q=0 F  S Q=$O(^PS(55,PSGP,"IV",+PSGORD,"A",Q)) Q:'Q!(PX["^")  D:($G(PN)>PSJFULL) NPAGE Q:PX["^"  S AND2=$G(^(Q,1,1,0)) I ($G(AND2)["OTHER PRINT INFO") D

 .S AND=$G(^PS(55,PSGP,"IV",+PSGORD,"A",Q,0)) D:($G(PN)>PSJFULL) NPAGE D AL1

 I ($G(PX)["^") S DONE=1

 Q

AL1 ; Activity Logs

 S UD=$P(AND,"^",3)

 I AND["SPECIAL INSTRUCTIONS" D  Q

 .I ($G(PSGORD)["U") D

 ..N LAST,Q2 S Q2=0 F  S Q2=$O(^PS(55,DFN,5,+PSGORD,9,Q,Q2)) Q:'Q2!(PX["^")  N Q3 S Q3=0 F  S Q3=$O(^PS(55,DFN,5,+PSGORD,9,Q,Q2,Q3)) Q:'Q3!(PX["^")  D

 ...S LAST=$G(LAST)+1

 ...I ($G(PSJCHTO)<2),(Q3=1),(Q2=1) D

 ....I '$G(PSJCHTO) D:($G(PN)>PSJFULL) NPAGE Q:($G(PX)["^")  D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")

 ....W !?INDENT1,"To:" S PN=$G(PN)+1 N TMPQ3 S TMPQ3=0 F  S TMPQ3=$O(^PS(55,DFN,5,+PSGORD,9,Q,Q2,TMPQ3)) Q:'TMPQ3!(PX["^")  W !?INDENT2,^PS(55,DFN,5,+PSGORD,9,Q,Q2,TMPQ3,0) S PN=$G(PN)+1 S PSJCHTO=2 K:TMPQ3=1 TMPTO S TMPTO(DFN,TMPQ3)=^(0)

 ...Q:PX["^"  D:($G(PN)>PSJFULL) NPAGE Q:PX["^"

 ...I (Q3=1),(Q2=1) D:($G(PN)>PSJFULL) NPAGE Q:($G(PX)["^")  D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")

 ...Q:($G(PX)["^")  I (Q3=1) W !?INDENT1,$S(PSJCHTO=2:"From: ",PSJCHTO=1:"To:",1:"") S PSJCHTO=$S(PSJCHTO=2:1,1:2) S PN=$G(PN)+1 D:($G(PN)>PSJFULL)

 ...W !?INDENT2,^PS(55,DFN,5,+PSGORD,9,Q,Q2,Q3,0) S PN=$G(PN)+1 K:Q3=1 TMPTO S:PSJCHTO=2 TMPTO(DFN,Q3)=^(0)

 ..I '$G(LAST) N Q2TM,Q0TM S Q2TM=$P($G(^PS(55,DFN,5,+PSGORD,9,Q,0)),"^"),Q0TM=$P($G(^PS(55,DFN,5,+PSGORD,9,1,0)),"^") Q:($$FMDIFF^XLFDT(Q2TM,Q0TM,2)>0)  D

 ...D CPYPC(DFN,PSGORD,Q)

 .I ($G(PSGORD)["P") D

 ..I '$O(^PS(53.1,+PSGORD,"A",Q,0)) D

 ...D:($G(PN)>PSJFULL) NPAGE Q:PX["^"  D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")

 ...N FROM S FROM=$P(AND,"^",5) W !?INDENT1,"From: " S PN=$G(PN)+1 S PSJCHTO=1 D

 ....I FROM]"" W !?INDENT2,FROM S PN=$G(PN)+1 Q

 ....I $D(TMPTO(DFN,1)) N TMPTOLN S TMPTOLN=0 F  S TMPTOLN=$O(TMPTO(DFN,TMPTOLN)) Q:'TMPTOLN!(PX["^")  W !?INDENT2,TMPTO(DFN,TMPTOLN) S PN=PN+1 D:($G(PN)>PSJFULL) NPAGE

 ..N QB S QB=0 F  S QB=$O(^PS(53.1,+PSGORD,"A",Q,QB)) Q:'QB!(PX["^")  N Q2 S Q2=0 F  S Q2=$O(^PS(53.1,+PSGORD,"A",Q,QB,Q2)) Q:'Q2!(PX["^")  D

 ...I ($G(PSJCHTO)<2),(Q2=1),(QB=1) W !?INDENT1,"To:" S PN=$G(PN)+1,PSJCHTO=2 D

 ....N TMPQ2 S TMPQ2=0 F  S TMPQ2=$O(^PS(53.1,+PSGORD,"A",Q,QB,TMPQ2)) Q:'TMPQ2!(PX["^")  W !?INDENT2,^PS(53.1,+PSGORD,"A",Q,QB,TMPQ2,0) S PN=$G(PN)+1 K:TMPQ2=1 TMPTO S TMPTO(DFN,TMPQ2)=^(0)

 ...Q:PX["^"

 ...I (Q2=1),(QB=1) D:($G(PN)>PSJFULL) NPAGE Q:PX["^"  D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")

 ...I (Q2=1) W !?INDENT1,$S(PSJCHTO=2:"From: ",PSJCHTO=2:"To:",1:"") S PSJCHTO=$S(PSJCHTO=2:1,1:2) S PN=$G(PN)+1

 ...Q:PX["^"  W !?INDENT2,^PS(53.1,+PSGORD,"A",Q,QB,Q2,0) S PN=$G(PN)+1 D:($G(PN)>PSJFULL) NPAGE Q:PX["^"  K:Q2=1 TMPTO S:PSJCHTO=2 TMPTO(DFN,Q2)=^(0)

 I $G(AND2)["OTHER PRINT INFO"!($G(AND)["OTHER PRINT INFO") S PSJIVFLG=1 D

 .I ($G(PSGORD)["V") N Q2 F Q2=2,3 Q:(PX["^")  N Q3 S Q3=0 F  S Q3=$O(^PS(55,DFN,"IV",+PSGORD,"A",Q,Q2,Q3)) Q:'Q3!(PX["^")  D

 ..I ($G(PSJCHTO)=1),Q2=2,Q3=1 D

 ...N TMPQ3 S TMPQ3=0 F  S TMPQ3=$O(^PS(55,DFN,"IV",+PSGORD,"A",Q,Q2,TMPQ3)) Q:'TMPQ3!(PX["^")  D

 ....D:($G(PN)>PSJFULL) NPAGE W:TMPQ3=1 !?INDENT1,"To: " W !?INDENT2,^PS(55,DFN,"IV",+PSGORD,"A",Q,Q2,TMPQ3,0) K:TMPQ3=1 TMPTO S TMPTO(DFN,TMPQ3)=^(0)

 ....S PN=PN+2,PSJCHTO=2 D:($G(PN)>PSJFULL) NPAGE Q:PX["^"

 ..Q:PX["^"

 ..I Q3=1,($G(PSJCHTO)'=1) D:($G(PN)>PSJFULL) NPAGE Q:PX["^"  D  Q:($G(PX)["^")

 ...D DATUSR($P(AND,"^",5),$P(AND,"^",3),"OTHER PRINT INFO changed")

 ...;W !!,"Date: ",$$ENDTC^PSGMI($P(AND,"^",5)) W ?28,"User: ",$$ENNPN^PSGMI($P(AND,"^",3)),!,"OTHER PRINT INFO changed" S PN=$G(PN)+3

 ..I Q3=1,Q2=3,'$G(PSJCHTO) W !?INDENT1,"From: """"" S PSJCHTO=1,PN=$G(PN)+1

 ..I Q3=1,Q2=3,PSJCHTO=2,$D(TMPTO(DFN,1)) W !?INDENT1,"From: " S PSJCHTO=1,PN=$G(PN)+1 N TMPTOLN S TMPTOLN=0 F  S TMPTOLN=$O(TMPTO(DFN,TMPTOLN)) Q:'TMPTOLN!(PX["^")  W !?INDENT2,TMPTO(DFN,TMPTOLN) S PN=PN+1 D:($G(PN)>PSJFULL) NPAGE

 ..Q:(PX["^")  I Q3=1 W !?INDENT1,$S(PSJCHTO'=1:"From: ",PSJCHTO=1:"To: ",1:"") S PSJCHTO=$S(PSJCHTO=1:2,1:1) S PN=PN+1 Q:PX["^"

 ..Q:PX["^"  W !?INDENT2,^PS(55,DFN,"IV",+PSGORD,"A",Q,Q2,Q3,0) K:Q3=1 TMPTO S:PSJCHTO=2 TMPTO(DFN,Q3)=^(0) S PN=PN+1 D:($G(PN)>PSJFULL) NPAGE Q:PX["^"

 .I $G(PN)>PSJFULL D NPAGE Q:(PX["^")

 .I ($G(PSGORD)["P") D:($G(PN)>PSJFULL) NPAGE Q:PX["^"  D

 ..I ($G(PSJCHTO)'=1) W !,"Date: ",$$ENDTC^PSGMI(+AND) W ?28,"User: ",$$ENNPN^PSGMI($P(AND,"^",2)),!,"OTHER PRINT INFO changed" S PN=$G(PN)+2

 ..I '$G(PSJCHTO) N FROM S FROM=$P(AND,"^",5),FROM=$S(FROM]"":FROM,1:"""""") W !?INDENT1,"From: ",!?INDENT2,FROM  S PSJCHTO=1,PN=$G(PN)+1

 ..N QB S QB=0 F  S QB=$O(^PS(53.1,+PSGORD,"A",Q,QB)) Q:'QB!($G(PX)["^")  N Q2 S Q2=0 F  S Q2=$O(^PS(53.1,+PSGORD,"A",Q,QB,Q2)) Q:'Q2!($G(PX)["^")  D

 ...I ($G(PSJCHTO)<2),(Q2=1),(QB=1) D:($G(PN)>PSJFULL) NPAGE W !?INDENT1,"To: " S PN=$G(PN)+2,PSJCHTO=2 D  W !

 ....N TMPQ2 S TMPQ2=0 F  S TMPQ2=$O(^PS(53.1,+PSGORD,"A",Q,QB,TMPQ2)) Q:'TMPQ2!(PX["^")  W !?INDENT2,^PS(53.1,+PSGORD,"A",Q,QB,TMPQ2,0) S PN=$G(PN)+1 D:($G(PN)>PSJFULL) NPAGE

 ...I (Q2=1),(QB=1) D DATUSR($P(AND,"^",5),$P(AND,"^",3),"OTHER PRINT INFO changed") ; W !,"Date: ",$$ENDTC^PSGMI(+AND) W:$S(UD'?4N:1,1:$E(UD,1,2)'=10) ?28,"User: ",$$ENNPN^PSGMI($P(AND,"^",2)),!,"OTHER PRINT INFO changed" S PN=$G(PN)+2

 ...I (Q2=1) D:($G(PN)>PSJFULL) NPAGE W !?INDENT1,$S(QB=1:"From: ",QB=2:"To: ",1:"") S PSJCHTO=$S(QB=2:2,1:1) S PN=$G(PN)+1

 ...Q:($G(PX)["^")  W !?INDENT2,^PS(53.1,+PSGORD,"A",Q,QB,Q2,0) S PN=$G(PN)+1 D:($G(PN)>PSJFULL) NPAGE Q:PX["^"

 ..I ($G(PN)>PSJFULL) D NPAGE

 Q

 ;

GETPRCOM ; Get provider comments

 N PROVLN

 I $G(PSGORD)["V" S PROVLN=0 F  S PROVLN=$O(^PS(55,DFN,"IV",+PSGORD,5,PROVLN)) Q:'PROVLN!($G(PX)["^")  D

 .I (PROVLN=1) S DT=$P($G(^PS(55,DFN,"IV",+PSGORD,2)),"^"),USR=$P($G(^PS(55,DFN,"IV",+PSGORD,0)),"^",6) D DATUSR(DT,USR,"PROVIDER COMMENTS:") S PSJPRCOM=1

 .W !?INDENT2,^PS(55,DFN,"IV",+PSGORD,5,PROVLN,0) S PN=$G(PN)+1 I ($G(PN)>PSJFULL) D NPAGE

 I $G(PSGORD)["U" S PROVLN=0 F  S PROVLN=$O(^PS(55,DFN,5,+PSGORD,12,PROVLN)) Q:'PROVLN!($G(PX)["^")  D

 .I (PROVLN=1) S DT=$P($G(^PS(55,DFN,5,+PSGORD,0)),"^",16),USR=$P($G(^PS(55,DFN,5,+PSGORD,0)),"^",2) D DATUSR(DT,USR,"PROVIDER COMMENTS:") S PSJPRCOM=1

 .W !?INDENT2,^PS(55,DFN,5,+PSGORD,12,PROVLN,0) S PN=$G(PN)+1 I ($G(PN)>PSJFULL) D NPAGE

 I $G(PSGORD)["P" S PROVLN=0 F  S PROVLN=$O(^PS(53.1,+PSGORD,12,PROVLN)) Q:'PROVLN!($G(PX)["^")  D

 .I (PROVLN=1) S DT=$P($G(^PS(53.1,+PSGORD,0)),"^",16),USR=$P($G(^PS(53.1,+PSGORD,0)),"^",2) D DATUSR(DT,USR,"PROVIDER COMMENTS:") S PSJPRCOM=1

 .W !?INDENT2,^PS(53.1,+PSGORD,12,PROVLN,0) S PN=$G(PN)+1 I ($G(PN)>PSJFULL) D NPAGE

 D:($G(PN)>PSJFULL) NPAGE

 Q

NPAGE ; Pause

 Q:$G(PSJPTR)

 I PN<PSJFULL F PN=PN:1:PSJFULL-1 W !

 I $E(IOST)="C" R !!,"Enter '^' to stop, or press RETURN to continue.",PX:DTIME D

 .I $G(PX)["^" S DONE=1

 .D FULL^VALM1 W @IOF

 W !?25,"Instructions History" S PN=1

 N DASH S $P(DASH,"-",75)="-" W !,DASH S PN=$G(PN)+1

 Q

 ;

DATUSR(DT,USR,TXT) ;

 I $G(PN)>(PSJFULL-5) D NPAGE Q:(PX["^")

 N DAT,USER

 S DAT=$$ENDTC^PSSGMI(DT),USER=$$ENNPN^PSGMI(USR)

 W !!,"Date: ",DAT,?28,"User: ",USER,!,TXT S PN=$G(PN)+3

 Q

 ;

CPYPC(DFN,PSGORD,Q) ; Handle Special Instructions copied in from Provider Comments during finishing

 Q:$O(^PS(55,DFN,5,+PSGORD,9,Q,0))

 N PS55ND0 S PS55ND0=$G(^PS(55,DFN,5,+PSGORD,0))

 N PRVORD S PRVORD=$P(PS55ND0,"^",25) Q:'PRVORD

 N PRVSI S PRVSI=$$GETSIOPI^PSJBCMA5(DFN,PRVORD,1) Q:'PRVSI

 I ($G(PSJCHTO)=2) D

 .D:($G(PN)>PSJFULL) NPAGE Q:($G(PX)["^")  D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")

 .W !?INDENT1,"From:" S PN=$G(PN)+1 N TMPQ3 S TMPQ3=0 F  S TMPQ3=$O(^TMP("PSJBCMA5",$J,DFN,PRVORD,TMPQ3)) Q:'TMPQ3!(PX["^")  D

 ..W !?INDENT2,^TMP("PSJBCMA5",$J,DFN,PRVORD,TMPQ3) S PN=$G(PN)+1 S PSJCHTO=2 K:TMPQ3=1 TMPTO S TMPTO(DFN,TMPQ3)=^TMP("PSJBCMA5",$J,DFN,PRVORD,TMPQ3)

 .S PSJCHTO=1

 Q:PX["^"  D:($G(PN)>PSJFULL) NPAGE Q:PX["^"

 D:($G(PN)>PSJFULL) NPAGE Q:($G(PX)["^")  D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")

 Q:($G(PX)["^")  W !?INDENT1,$S(PSJCHTO=2:"From: ",PSJCHTO=1:"To:",1:"") S PSJCHTO=$S(PSJCHTO=2:1,1:2) S PN=$G(PN)+1

 N TOSI,FOUNDTO S TOSI=Q F  Q:$G(FOUNDTO)  S TOSI=$O(^PS(55,DFN,5,+PSGORD,9,TOSI)) Q:'TOSI  I $G(^PS(55,DFN,5,+PSGORD,9,TOSI,0))["SPECIAL INSTRUCTIONS" S FOUNDTO=TOSI

 I $G(FOUNDTO) S TOSI=0 F  S TOSI=$O(^PS(55,DFN,5,+PSGORD,9,FOUNDTO,1,TOSI)) Q:'TOSI  D

 .W !?INDENT2,^PS(55,DFN,5,+PSGORD,9,FOUNDTO,1,TOSI,0) S PN=$G(PN)+1 K:TOSI=1 TMPTO S:PSJCHTO=2 TMPTO(DFN,TOSI)=^(0)

 Q:$G(FOUNDTO)

 S TOSI=0 F  S TOSI=$O(^PS(55,DFN,5,+PSGORD,15,TOSI)) Q:'TOSI  W !?INDENT2,$G(^(TOSI,0))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSJINVW   13358     printed  Feb 18, 2025@23:33:35                                                                                                                                                                                                    Page 2

PSJINVW   ;BIR/CML3-INSTRUCTION HISTORY ;17 SEP 97 /  1:41 PM

 +1       ;;5.0;INPATIENT MEDICATIONS;**267,275**;16 DEC 97;Build 157

 +2       ;

 +3       ; Reference to ^PS(50.7 is supported by DBIA# 2180.

 +4       ; Reference to ^PS(51.2 is supported by DBIA# 2178.

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

 +6       ;

EN0(PSJINHIS,PSJCHTO) ;

 +1        NEW PNM,PSJFULL

           SET PSJFULL=20

 +2        DO EN2

           QUIT 

 +3        QUIT 

EN2       ;

 +1        IF PSGORD=+PSGORD

               NEW PSGO,PSGO1

               SET PSGO=PSGORD

               SET PSGO1=0

               FOR 

                   SET PSGO1=$ORDER(^PS(53.1,"ACX",PSGO,PSGO1))

                   if 'PSGO1

                       QUIT 

                   if $GET(PSGOEA)["^"

                       QUIT 

                   SET PSGORD=PSGO1_"P"

                   Begin DoDot:1

 +2                    DO EN21

                       KILL CONT

                       Begin DoDot:2

 +3                        WRITE !!,"Press RETURN to continue or '^' to exit: "

                           SET PN=$GET(PN)+2

                           READ CONT:DTIME

                           WRITE @IOF

                           if CONT["^"

                               SET PSGOEA="^"

                               SET PSGPR=1

                               SET PSJPR=1

                       End DoDot:2

                       if $GET(PSGOEA)["^"

                           QUIT 

                   End DoDot:1

                   SET PSGORD=""

 +4        IF PSGORD=""

               SET PSGOEA="^"

               QUIT 

EN21      ;

 +1        NEW PSIVFLG

           SET PSIVFLG=0

           IF PSGORD["P"

               SET PSIVFLG=$PIECE(^PS(53.1,+PSGORD,0),"^",4)

               SET PSIVFLG=$SELECT(PSIVFLG="F":1,PSIVFLG="I":1,1:0)

 +2        SET NF=$SELECT(PSGORD["P":1,PSGORD["N":1,1:0)

 +3        SET (FL,Y)=""

           SET $PIECE(FL,"-",71)=""

           SET F="^PS("_$SELECT(NF:"53.1,",(PSGORD["V"):"55,"_PSGP_",""IV"",",1:"55,"_PSGP_",5,")_+PSGORD_","

 +4        SET PNM=$GET(PSGP(0))

           if PNM=""

               SET PNM=$PIECE($GET(^DPT(PSGP,0)),"^")

 +5        if ($GET(@(F_"0)"))="")

               QUIT 

 +6        IF $GET(PSJINHIS)

               DO PSJINHIS(1,.PSJCHTO)

               QUIT 

DONE      ;

 +1        KILL AND,D,DRG1,DRG2,AT,DO,DRG,EB,F,FD,FL,HSM,INS,LID,MR,ND4,OD,PN,PR,PSGID,PSGOD,R,SCH,SCT,SI,SIG,SM,ST,STD,UD,X,XU,Y,DONE,NF,

           QUIT 

 +2        QUIT 

 +3       ;

PSJINHIS(PSJINHIS,PSJCHTO) ;

 +1        IF '$GET(PSJHDRF)

               SET PSJHDRF=1

               NEW DASH

               SET $PIECE(DASH,"-",75)="-"

               Begin DoDot:1

 +2                IF $EXTRACT(IOST)="C"

                       DO FULL^VALM1

                       WRITE @IOF

 +3                WRITE !?25,"Instructions History",!,DASH

                   SET PN=$GET(PN)+2

               End DoDot:1

 +4        NEW AND,AND2,PX

           SET PX=""

 +5        NEW INDENT1,INDENT2

           SET INDENT1=2

           SET INDENT2=5

 +6        IF '$GET(PSJPRCOM)

               DO GETPRCOM

               if ($GET(PX)["^")

                   QUIT 

 +7        DO ENA

           if ($GET(PX)["^")

               QUIT 

 +8        if $GET(PSJCHTO)=2

               QUIT 

 +9        IF $GET(PSGORD)["V"!$GET(PSIVFLG)

               DO PSGOPI

               QUIT 

 +10       DO PSGSI

 +11       QUIT 

 +12      ;

PSGSI     ;

 +1        NEW SI,Q,QQ,QQQ

           SET SI=$SELECT(($GET(PSGORD)["P"):$PIECE($GET(^PS(53.1,+PSGORD,6)),"^"),($GET(PSGORD)["U"):$PIECE($GET(^PS(55,PSGP,5,+PSGORD,6)),"^"),1:"")

 +2        NEW SIL

           SET SIL=$$GETSIOPI^PSJBCMA5(PSGP,PSGORD,1)

           IF SIL!(SI]"")

               Begin DoDot:1

 +3                if ($GET(PX)["^")

                       QUIT 

 +4                IF '$GET(PSJCHTO)

                       NEW PSJUDGL,PSJUDPH

                       SET PSJUDGL=$SELECT($GET(PSGORD)["P":"^PS(53.1,+PSGORD,",$GET(PSGORD)["U":"^PS(55,PSGP,5,+PSGORD,",1:"")

                       Begin DoDot:2

 +5                        IF '$GET(AND)

                               NEW AND

                               SET AND=$PIECE(@(PSJUDGL_"0)"),"^",16)

                               SET PSJUDPH=@(PSJUDGL_"4)")

                               SET $PIECE(AND,"^",2)=$SELECT($PIECE(PSJUDPH,"^",3):$PIECE(PSJUDPH,"^",3),$PIECE(PSJUDPH,"^",7):$PIECE(PSJUDPH,"^",7),1:"")

 +6                        if $GET(PN)>PSJFULL

                               DO NPAGE

                           WRITE !!,"Date: ",$$ENDTC^PSGMI(+AND)

                           SET PN=$GET(PN)+3

                           WRITE ?28,"User: ",$$ENNPN^PSGMI($PIECE(AND,"^",2)),!?INDENT1,"SPECIAL INSTRUCTIONS changed"

                           Begin DoDot:3

 +7                            WRITE !?INDENT1,"From: ''",!

                               SET PSJCHTO=1

                               SET PN=$GET(PN)+2

                           End DoDot:3

                       End DoDot:2

 +8                IF SI]""

                       IF 'SIL

                           WRITE !?INDENT1,"To:",!?INDENT2

                           SET PSJCHTO=2

                           SET PN=$GET(PN)+2

                           Begin DoDot:2

 +9                            SET QQQ=""

                               FOR Q=1:1:$LENGTH(SI," ")

                                   SET QQ=$PIECE(SI," ",Q)

                                   if ($LENGTH(QQQ_" "_QQ)>72)

                                       WRITE !

                                   WRITE QQ," "

                                   if ($LENGTH(QQQ_" "_QQ)>72)

                                       SET QQQ=""

                                   SET QQQ=QQQ_" "_QQ

                           End DoDot:2

                           QUIT 

 +10               IF $GET(PSJCHTO)=2

                       IF $DATA(TMPTO(DFN,1))

                           WRITE !?INDENT1,"From: "

                           SET PSJCHTO=1

                           SET PN=$GET(PN)+1

                           NEW TMPTOLN

                           SET TMPTOLN=0

                           FOR 

                               SET TMPTOLN=$ORDER(TMPTO(DFN,TMPTOLN))

                               if 'TMPTOLN!(PX["^")

                                   QUIT 

                               WRITE !?INDENT2,TMPTO(DFN,TMPTOLN)

                               SET PN=PN+1

                               if ($GET(PN)>PSJFULL)

                                   DO NPAGE