Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJINVW

PSJINVW.m

Go to the documentation of this file.
  1. PSJINVW ;BIR/CML3-INSTRUCTION HISTORY ;17 SEP 97 / 1:41 PM
  1. ;;5.0;INPATIENT MEDICATIONS;**267,275**;16 DEC 97;Build 157
  1. ;
  1. ; Reference to ^PS(50.7 is supported by DBIA# 2180.
  1. ; Reference to ^PS(51.2 is supported by DBIA# 2178.
  1. ; Reference to ^PS(55 is supported by DBIA# 2191.
  1. ;
  1. EN0(PSJINHIS,PSJCHTO) ;
  1. N PNM,PSJFULL S PSJFULL=20
  1. D EN2 Q
  1. Q
  1. EN2 ;
  1. 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=""
  1. . D EN21 K CONT D Q:$G(PSGOEA)["^"
  1. .. 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
  1. I PSGORD="" S PSGOEA="^" Q
  1. EN21 ;
  1. 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)
  1. S NF=$S(PSGORD["P":1,PSGORD["N":1,1:0)
  1. S (FL,Y)="",$P(FL,"-",71)="",F="^PS("_$S(NF:"53.1,",(PSGORD["V"):"55,"_PSGP_",""IV"",",1:"55,"_PSGP_",5,")_+PSGORD_","
  1. S PNM=$G(PSGP(0)) S:PNM="" PNM=$P($G(^DPT(PSGP,0)),"^")
  1. Q:($G(@(F_"0)"))="")
  1. I $G(PSJINHIS) D PSJINHIS(1,.PSJCHTO) Q
  1. DONE ;
  1. 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
  1. Q
  1. ;
  1. PSJINHIS(PSJINHIS,PSJCHTO) ;
  1. I '$G(PSJHDRF) S PSJHDRF=1 N DASH S $P(DASH,"-",75)="-" D
  1. .I $E(IOST)="C" D FULL^VALM1 W @IOF
  1. .W !?25,"Instructions History",!,DASH S PN=$G(PN)+2
  1. N AND,AND2,PX S PX=""
  1. N INDENT1,INDENT2 S INDENT1=2,INDENT2=5
  1. I '$G(PSJPRCOM) D GETPRCOM Q:($G(PX)["^")
  1. D ENA Q:($G(PX)["^")
  1. Q:$G(PSJCHTO)=2
  1. I $G(PSGORD)["V"!$G(PSIVFLG) D PSGOPI Q
  1. D PSGSI
  1. Q
  1. ;
  1. PSGSI ;
  1. 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:"")
  1. N SIL S SIL=$$GETSIOPI^PSJBCMA5(PSGP,PSGORD,1) I SIL!(SI]"") D
  1. .Q:($G(PX)["^")
  1. .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
  1. ..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:"")
  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
  1. ...W !?INDENT1,"From: ''",! S PSJCHTO=1 S PN=$G(PN)+2
  1. .I SI]"",'SIL W !?INDENT1,"To:",!?INDENT2 S PSJCHTO=2,PN=$G(PN)+2 D Q
  1. ..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
  1. .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
  1. .Q:'$G(PSJSYSP) N LNTXT S LNTXT=0 F S LNTXT=$O(^TMP("PSJBCMA5",$J,PSGP,PSGORD,LNTXT)) Q:'LNTXT D
  1. ..I LNTXT=1 W !?INDENT1,"To:" S PSJCHTO=2 S PN=$G(PN)+1
  1. ..W !?INDENT2,$G(^TMP("PSJBCMA5",$J,PSGP,PSGORD,LNTXT)) S PN=$G(PN)+1 K:LNTXT=1 TMPTO S TMPTO(DFN,LNTXT)=^(LNTXT)
  1. Q
  1. ;
  1. PSGOPI ;
  1. 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:"")
  1. S POPIL=$$GETSIOPI^PSJBCMA5(PSGP,PSGORD,1) I POPIL!(POPI]"") D
  1. .Q:($G(PX)["^")
  1. .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
  1. ..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:"")
  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
  1. ...W !?INDENT1,"From: ",!?INDENT2,"""""",! S PSJCHTO=1 S PN=$G(PN)+4
  1. .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
  1. .S TXTLN=0 F S TXTLN=$O(^TMP("PSJBCMA5",$J,PSGP,PSGORD,TXTLN)) Q:'TXTLN!($G(PX)["^") D
  1. ..I (TXTLN=1) W !?INDENT1,"To:" S PN=$G(PN)+1
  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
  1. Q
  1. ENA ;
  1. 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
  1. 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
  1. 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
  1. .S AND=$G(^PS(55,PSGP,"IV",+PSGORD,"A",Q,0)) D:($G(PN)>PSJFULL) NPAGE D AL1
  1. I ($G(PX)["^") S DONE=1
  1. Q
  1. AL1 ; Activity Logs
  1. S UD=$P(AND,"^",3)
  1. I AND["SPECIAL INSTRUCTIONS" D Q
  1. .I ($G(PSGORD)["U") D
  1. ..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
  1. ...S LAST=$G(LAST)+1
  1. ...I ($G(PSJCHTO)<2),(Q3=1),(Q2=1) D
  1. ....I '$G(PSJCHTO) D:($G(PN)>PSJFULL) NPAGE Q:($G(PX)["^") D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")
  1. ....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)
  1. ...Q:PX["^" D:($G(PN)>PSJFULL) NPAGE Q:PX["^"
  1. ...I (Q3=1),(Q2=1) D:($G(PN)>PSJFULL) NPAGE Q:($G(PX)["^") D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")
  1. ...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)
  1. ...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)
  1. ..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
  1. ...D CPYPC(DFN,PSGORD,Q)
  1. .I ($G(PSGORD)["P") D
  1. ..I '$O(^PS(53.1,+PSGORD,"A",Q,0)) D
  1. ...D:($G(PN)>PSJFULL) NPAGE Q:PX["^" D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")
  1. ...N FROM S FROM=$P(AND,"^",5) W !?INDENT1,"From: " S PN=$G(PN)+1 S PSJCHTO=1 D
  1. ....I FROM]"" W !?INDENT2,FROM S PN=$G(PN)+1 Q
  1. ....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
  1. ..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
  1. ...I ($G(PSJCHTO)<2),(Q2=1),(QB=1) W !?INDENT1,"To:" S PN=$G(PN)+1,PSJCHTO=2 D
  1. ....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)
  1. ...Q:PX["^"
  1. ...I (Q2=1),(QB=1) D:($G(PN)>PSJFULL) NPAGE Q:PX["^" D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")
  1. ...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
  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)
  1. I $G(AND2)["OTHER PRINT INFO"!($G(AND)["OTHER PRINT INFO") S PSJIVFLG=1 D
  1. .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
  1. ..I ($G(PSJCHTO)=1),Q2=2,Q3=1 D
  1. ...N TMPQ3 S TMPQ3=0 F S TMPQ3=$O(^PS(55,DFN,"IV",+PSGORD,"A",Q,Q2,TMPQ3)) Q:'TMPQ3!(PX["^") D
  1. ....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)
  1. ....S PN=PN+2,PSJCHTO=2 D:($G(PN)>PSJFULL) NPAGE Q:PX["^"
  1. ..Q:PX["^"
  1. ..I Q3=1,($G(PSJCHTO)'=1) D:($G(PN)>PSJFULL) NPAGE Q:PX["^" D Q:($G(PX)["^")
  1. ...D DATUSR($P(AND,"^",5),$P(AND,"^",3),"OTHER PRINT INFO changed")
  1. ...;W !!,"Date: ",$$ENDTC^PSGMI($P(AND,"^",5)) W ?28,"User: ",$$ENNPN^PSGMI($P(AND,"^",3)),!,"OTHER PRINT INFO changed" S PN=$G(PN)+3
  1. ..I Q3=1,Q2=3,'$G(PSJCHTO) W !?INDENT1,"From: """"" S PSJCHTO=1,PN=$G(PN)+1
  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
  1. ..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["^"
  1. ..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["^"
  1. .I $G(PN)>PSJFULL D NPAGE Q:(PX["^")
  1. .I ($G(PSGORD)["P") D:($G(PN)>PSJFULL) NPAGE Q:PX["^" D
  1. ..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
  1. ..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
  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
  1. ...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 !
  1. ....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
  1. ...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
  1. ...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
  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["^"
  1. ..I ($G(PN)>PSJFULL) D NPAGE
  1. Q
  1. ;
  1. GETPRCOM ; Get provider comments
  1. N PROVLN
  1. I $G(PSGORD)["V" S PROVLN=0 F S PROVLN=$O(^PS(55,DFN,"IV",+PSGORD,5,PROVLN)) Q:'PROVLN!($G(PX)["^") D
  1. .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
  1. .W !?INDENT2,^PS(55,DFN,"IV",+PSGORD,5,PROVLN,0) S PN=$G(PN)+1 I ($G(PN)>PSJFULL) D NPAGE
  1. I $G(PSGORD)["U" S PROVLN=0 F S PROVLN=$O(^PS(55,DFN,5,+PSGORD,12,PROVLN)) Q:'PROVLN!($G(PX)["^") D
  1. .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
  1. .W !?INDENT2,^PS(55,DFN,5,+PSGORD,12,PROVLN,0) S PN=$G(PN)+1 I ($G(PN)>PSJFULL) D NPAGE
  1. I $G(PSGORD)["P" S PROVLN=0 F S PROVLN=$O(^PS(53.1,+PSGORD,12,PROVLN)) Q:'PROVLN!($G(PX)["^") D
  1. .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
  1. .W !?INDENT2,^PS(53.1,+PSGORD,12,PROVLN,0) S PN=$G(PN)+1 I ($G(PN)>PSJFULL) D NPAGE
  1. D:($G(PN)>PSJFULL) NPAGE
  1. Q
  1. NPAGE ; Pause
  1. Q:$G(PSJPTR)
  1. I PN<PSJFULL F PN=PN:1:PSJFULL-1 W !
  1. I $E(IOST)="C" R !!,"Enter '^' to stop, or press RETURN to continue.",PX:DTIME D
  1. .I $G(PX)["^" S DONE=1
  1. .D FULL^VALM1 W @IOF
  1. W !?25,"Instructions History" S PN=1
  1. N DASH S $P(DASH,"-",75)="-" W !,DASH S PN=$G(PN)+1
  1. Q
  1. ;
  1. DATUSR(DT,USR,TXT) ;
  1. I $G(PN)>(PSJFULL-5) D NPAGE Q:(PX["^")
  1. N DAT,USER
  1. S DAT=$$ENDTC^PSSGMI(DT),USER=$$ENNPN^PSGMI(USR)
  1. W !!,"Date: ",DAT,?28,"User: ",USER,!,TXT S PN=$G(PN)+3
  1. Q
  1. ;
  1. CPYPC(DFN,PSGORD,Q) ; Handle Special Instructions copied in from Provider Comments during finishing
  1. Q:$O(^PS(55,DFN,5,+PSGORD,9,Q,0))
  1. N PS55ND0 S PS55ND0=$G(^PS(55,DFN,5,+PSGORD,0))
  1. N PRVORD S PRVORD=$P(PS55ND0,"^",25) Q:'PRVORD
  1. N PRVSI S PRVSI=$$GETSIOPI^PSJBCMA5(DFN,PRVORD,1) Q:'PRVSI
  1. I ($G(PSJCHTO)=2) D
  1. .D:($G(PN)>PSJFULL) NPAGE Q:($G(PX)["^") D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")
  1. .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
  1. ..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)
  1. .S PSJCHTO=1
  1. Q:PX["^" D:($G(PN)>PSJFULL) NPAGE Q:PX["^"
  1. D:($G(PN)>PSJFULL) NPAGE Q:($G(PX)["^") D DATUSR(+AND,$P(AND,"^",2),"SPECIAL INSTRUCTIONS changed")
  1. 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
  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
  1. I $G(FOUNDTO) S TOSI=0 F S TOSI=$O(^PS(55,DFN,5,+PSGORD,9,FOUNDTO,1,TOSI)) Q:'TOSI D
  1. .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)
  1. Q:$G(FOUNDTO)
  1. S TOSI=0 F S TOSI=$O(^PS(55,DFN,5,+PSGORD,15,TOSI)) Q:'TOSI W !?INDENT2,$G(^(TOSI,0))
  1. Q