source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSREMCH.m@ 876

Last change on this file since 876 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 9.5 KB
Line 
1PSSREMCH ;BIR/RTR-Pre release Orderable Item report ;02/14/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**34**;9/30/97
3 S PSSOUT=0 D TEXT^PSSUTLPR I $G(PSSOUT) K PSSOUT Q
4 G ADDRP^PSSUTLPR
5ADD ;
6 N AAZ,AAZZ,SSZ,SSZZ,PSSATMP,PSSSTMP
7 U IO S PSSOUT=0 K PSSADSUM,PSSTOTAL,PSSIVID,PSSIVIDL,PSSSOSUM
8 S PSSDV=$S($E(IOST)="C":"C",1:"P"),PSSCOT=1
9 S PSSIVID=$S($P($G(^PS(59.7,1,31)),"^",2)'="":$P($G(^(31)),"^",2),1:"IV") S PSSIVIDL=$L(PSSIVID)
10 I $G(PSSTYPE)="S" G SOL
11 S PSSWH="A"
12 N ADD,AA,OI,PAD,ADDIEN,ZERO,LEN,COUNT,PSSAD,PAA,PZZ,PDD,OINAME,OIDOSE,OILT,TOTAL,PSSPADZ,AOILT,NEWOI,NEWOIL,ADDLT,PSSADIN,PSSADID,OIDATE,OIDATED,PSSPADX,PSSPADZZ,OIZD,OIZDZ,PSINDAT,PSINDATE
13 K ^TMP($J,"PSSAD")
14 D ADDH
15 S ADD="" F S ADD=$O(^PS(52.6,"B",ADD)) Q:ADD=""!($G(PSSOUT)) F ADDIEN=0:0 S ADDIEN=$O(^PS(52.6,"B",ADD,ADDIEN)) Q:'ADDIEN!($G(PSSOUT)) D
16 .Q:'$P($G(^PS(52.6,ADDIEN,0)),"^",11)
17 .S ZERO=$G(^PS(52.6,ADDIEN,0)),LEN=$L($P(ZERO,"^"))
18 .K PSSADID S PSSADIN=$P($G(^PS(52.6,ADDIEN,"I")),"^") I PSSADIN S PSSADID="("_$E(PSSADIN,4,5)_"/"_$E(PSSADIN,6,7)_"/"_$E(PSSADIN,2,3)_")"
19 .S LEN=LEN+$S($G(PSSADID)'="":11,1:0)
20 .K PAD S $P(PAD,"=",(42-LEN))="",PAD=$G(PAD)_"> "
21 .S OINAME=$P($G(^PS(50.7,+$P(ZERO,"^",11),0)),"^"),OIDOSE=$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"),OILT=$L($G(OINAME))+$L($G(OIDOSE))+2
22 .K OIDATED S OIDATE=$P($G(^PS(50.7,+$P(ZERO,"^",11),0)),"^",4) I OIDATE S OIDATED="("_$E(OIDATE,4,5)_"/"_$E(OIDATE,6,7)_"/"_$E(OIDATE,2,3)_")"
23 .S ADDLT=$L(ADDIEN)+3
24 .S PSSTOTAL=+$G(ADDLT)+45+$G(OILT)+$S($G(OIDATED)'="":11,1:0)+$G(PSSIVIDL)
25 .S PSSPADZ=+$G(ADDLT)+42
26 .I ($Y+5)>IOSL D ADDH Q:$G(PSSOUT)
27 .W !!,?3,"Current Additive/Orderable Item match:",!
28 .I $G(PSSTOTAL)<132 W "("_$G(ADDIEN)_") "_$P(ZERO,"^")_$S($G(PSSADID)'="":" "_$G(PSSADID),1:"")_$G(PAD)_$G(OINAME)_" "_$G(OIDOSE)_$S($G(OIDATED)'="":" "_$G(OIDATED),1:"")_" "_$G(PSSIVID)
29 .I $G(PSSTOTAL)>131 W "("_$G(ADDIEN)_") "_$P(ZERO,"^")_$S($G(PSSADID)'="":" "_$G(PSSADID),1:"")_$G(PAD) W !,"=====> ",$G(OINAME)_" "_$G(OIDOSE)_$S($G(OIDATED)'="":" "_$G(OIDATED),1:"")_" "_$G(PSSIVID)
30 .S OI=$P($G(^PSDRUG(+$P(ZERO,"^",2),2)),"^") I 'OI W !?5,"cannot re-match, no Orderable Item for the Dispense Drug" Q
31 .S PSSATMP=$P($G(^PS(50.7,OI,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")
32 .S ^TMP($J,"PSSAD",PSSATMP,ADDIEN)=OI
33 .S NEWOI=$P($G(^PS(50.7,+$G(OI),0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")
34 .K OIZDZ S OIZD=$P($G(^PS(50.7,+$G(OI),0)),"^",4) I OIZD S OIZDZ="("_$E(OIZD,4,5)_"/"_$E(OIZD,6,7)_"/"_$E(OIZD,2,3)_")"
35 .K PSSPADZZ S PSSPADX=$G(PSSPADZ)-18 S $P(PSSPADZZ,"=",PSSPADX)=""
36 .S PSSPADZZ=PSSPADZZ_"> "
37 .W !,"New Orderable Item"_$G(PSSPADZZ)_$G(NEWOI)_$S($G(OIZDZ)'="":" "_$G(OIZDZ),1:"")
38 .W !?2,"Dispense Drugs matched to Orderable Item:"
39 .F PAA=0:0 S PAA=$O(^PSDRUG("ASP",OI,PAA)) Q:'PAA!($G(PSSOUT)) D
40 ..I ($Y+4)>IOSL D ADDH Q:$G(PSSOUT)
41 ..K PSINDATE S PSINDAT=$P($G(^PSDRUG(PAA,"I")),"^") I PSINDAT S PSINDATE=" "_"("_$E(PSINDAT,4,5)_"/"_$E(PSINDAT,6,7)_"/"_$E(PSINDAT,2,3)_")"
42 ..I PSINDAT,PSINDAT<$G(PSSYRX) Q
43 ..W !?4,$P($G(^PSDRUG(PAA,0)),"^")_$G(PSINDATE) I PAA=$P(ZERO,"^",2) W ?55,"(Additive link)"
44 I $G(PSSOUT) G ADDX
45 D ADDHS G:$G(PSSOUT) ADDX
46 S PSSADSUM=1
47 S AA="" F S AA=$O(^TMP($J,"PSSAD",AA)) Q:AA=""!($G(PSSOUT)) D
48 .S AAZ=$O(^TMP($J,"PSSAD",AA,0)),AAZZ=+$G(^TMP($J,"PSSAD",AA,+$G(AAZ)))
49 .I ($Y+4)>IOSL D ADDH Q:$G(PSSOUT)
50 .W !!,"OI => ",AA_$S($P($G(^PS(50.7,AAZZ,0)),"^",4)="":"",1:" ("_$E($P($G(^(0)),"^",4),4,5)_"/"_$E($P($G(^(0)),"^",4),6,7)_"/"_$E($P($G(^(0)),"^",4),2,3)_")")
51 .F PZZ=0:0 S PZZ=$O(^TMP($J,"PSSAD",AA,PZZ)) Q:'PZZ!($G(PSSOUT)) D
52 ..I ($Y+4)>IOSL D ADDH Q:$G(PSSOUT)
53 ..W !,"("_$G(PZZ)_") ",?13,$P($G(^PS(52.6,PZZ,0)),"^")_$S($P($G(^("I")),"^")="":"",1:" ("_$E($P($G(^("I")),"^"),4,5)_"/"_$E($P($G(^("I")),"^"),6,7)_"/"_$E($P($G(^("I")),"^"),2,3)_")"),?69,"(Additive)"
54 .Q:$G(PSSOUT)
55 .W !?2,"Dispense Drugs matched to OI:"
56 .F PDD=0:0 S PDD=$O(^PSDRUG("ASP",AAZZ,PDD)) Q:'PDD!($G(PSSOUT)) D
57 ..I ($Y+4)>IOSL D ADDH Q:$G(PSSOUT)
58 ..I $P($G(^PSDRUG(PDD,"I")),"^"),$P($G(^("I")),"^")<$G(PSSYRX) Q
59 ..W !,?11,$P($G(^PSDRUG(PDD,0)),"^")_$S($P($G(^("I")),"^")="":"",1:" ("_$E($P($G(^("I")),"^"),4,5)_"/"_$E($P($G(^("I")),"^"),6,7)_"/"_$E($P($G(^("I")),"^"),2,3)_")")
60ADDX ;
61 K ^TMP($J,"PSSAD")
62 I $G(PSSTYPE)="B",'$G(PSSOUT) G SOL
63 I '$G(PSSOUT) D PDIR
64 G END
65SOL ;
66 K ^TMP($J,"PSSOL"),PSSCOTX
67 S PSSWH="S"
68 N SOL,SLDD,SZZ,SOLAA,SAA,SOLIEN,SNAME,SLNEWOI,SOINAME,SOIDOSE,SOILT,SOILTX,STOTAL,SLOI,SDA,SDAT,SDOI,SDOID,SOLLT,PSSSOLZ,SOIZD,SOIZDZ,SZL,SZLA,SLID,SLIDD
69 D SOLH S PSSCOTX=1
70 I $G(PSSOUT) G SEND
71 S SOL="" F S SOL=$O(^PS(52.7,"B",SOL)) Q:SOL=""!($G(PSSOUT)) F SOLIEN=0:0 S SOLIEN=$O(^PS(52.7,"B",SOL,SOLIEN)) Q:'SOLIEN!($G(PSSOUT)) D
72 .Q:'$P($G(^PS(52.7,SOLIEN,0)),"^",11)
73 .S ZERO=$G(^PS(52.7,SOLIEN,0))
74 .S SNAME=$P(ZERO,"^")_" ("_$P(ZERO,"^",3)_")",LEN=$L(SNAME)
75 .K SDAT S SDA=$P($G(^PS(52.7,SOLIEN,"I")),"^") I SDA S SDAT="("_$E(SDA,4,5)_"/"_$E(SDA,6,7)_"/"_$E(SDA,2,3)_")"
76 .S LEN=LEN+$S($G(SDAT)'="":11,1:0)
77 .K PAD S $P(PAD,"=",(53-LEN))="",PAD=$G(PAD)_"> "
78 .S SOINAME=$P($G(^PS(50.7,+$P(ZERO,"^",11),0)),"^"),SOIDOSE=$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"),SOILT=$L($G(SOINAME))+$L($G(SOIDOSE))+2
79 .K SDOID S SDOI=$P($G(^PS(50.7,+$P(ZERO,"^",11),0)),"^",4) I SDOI S SDOID="("_$E(SDOI,4,5)_"/"_$E(SDOI,6,7)_"/"_$E(SDOI,2,3)_")"
80 .S SOLLT=$L(SOLIEN)+3
81 .S PSSTOTAL=+$G(SOLLT)+67+$G(SOILT)+$S($G(PDOID)'="":11,1:0)+$G(PSSIVIDL)
82 .S PSSSOLZ=+$G(SOLLT)+53
83 .I ($Y+5)>IOSL D SOLH Q:$G(PSSOUT)
84 .W !!?3,"Current Solution/Orderable Item match:",!
85 .I $G(PSSTOTAL)<132 W "("_$G(SOLIEN)_") "_$G(SNAME)_$S($G(SDAT)'="":" "_$G(SDAT),1:"")_$G(PAD)_$G(SOINAME)_" "_$G(SOIDOSE)_$S($G(SDOID)'="":" "_$G(SDOID),1:"")_" "_$G(PSSIVID)
86 .I $G(PSSTOTAL)>131 W "("_$G(SOLIEN)_") "_$G(SNAME)_$S($G(SDAT)'="":" "_$G(SDAT),1:"")_$G(PAD) D:($Y+4)>IOSL SOLH Q:$G(PSSOUT) W !,"=====> ",$G(SOINAME)_" "_$G(SOIDOSE)_$S($G(SDOID)'="":" "_$G(SDOID),1:"")_" "_$G(PSSIVID)
87 .S SLOI=$P($G(^PSDRUG(+$P(ZERO,"^",2),2)),"^") I 'SLOI W !?5,"cannot rematch, no Item for the Dispense Drug" Q
88 .S PSSSTMP=$P($G(^PS(50.7,+$G(SLOI),0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")
89 .S ^TMP($J,"PSSOL",PSSSTMP,SOLIEN)=SLOI
90 .S SLNEWOI=$P($G(^PS(50.7,+$G(SLOI),0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")
91 .K SOIZDZ S SOIZD=$P($G(^PS(50.7,+$G(SLOI),0)),"^",4) I SOIZD S SOIZDZ="("_$E(SOIZD,4,5)_"/"_$E(SOIZD,6,7)_"/"_$E(SOIZD,2,3)_")"
92 .K SZL S SZLA=$G(PSSSOLZ)-18 S $P(SZL,"=",SZLA)="" S SZL=SZL_"> "
93 .W !,"New Orderable Item"_$G(SZL)_$G(SLNEWOI)_$S($G(SOIZDZ)'="":" "_$G(SOIZDZ),1:"")
94 .W !?2,"Dispense Drugs matched to Orderable Item:"
95 .F SAA=0:0 S SAA=$O(^PSDRUG("ASP",SLOI,SAA)) Q:'SAA!($G(PSSOUT)) D
96 ..I ($Y+4)>IOSL D SOLH Q:$G(PSSOUT)
97 ..K SLID S SLIDD=$P($G(^PSDRUG(SAA,"I")),"^") I SLIDD S SLID=" "_"("_$E(SLIDD,4,5)_"/"_$E(SLIDD,6,7)_"/"_$E(SLIDD,2,3)_")"
98 ..I SLIDD,SLIDD<$G(PSSYRX) Q
99 ..W !?4,$P($G(^PSDRUG(SAA,0)),"^")_$G(SLID) I SAA=$P(ZERO,"^",2) W ?59,"(Solution link)"
100 I $G(PSSOUT) G SEND
101 D SOLHS G:$G(PSSOUT) SEND
102 S PSSSOSUM=1
103 S SOLAA="" F S SOLAA=$O(^TMP($J,"PSSOL",SOLAA)) Q:SOLAA=""!($G(PSSOUT)) D
104 .S SSZ=$O(^TMP($J,"PSSOL",SOLAA,0)),SSZZ=+$G(^TMP($J,"PSSOL",SOLAA,+$G(SSZ)))
105 .I ($Y+4)>IOSL D SOLH Q:$G(PSSOUT)
106 .W !!,"OI => ",SOLAA_$S($P($G(^PS(50.7,SSZZ,0)),"^",4)="":"",1:" ("_$E($P($G(^(0)),"^",4),4,5)_"/"_$E($P($G(^(0)),"^",4),6,7)_"/"_$E($P($G(^(0)),"^",4),2,3)_")")
107 .F SZZ=0:0 S SZZ=$O(^TMP($J,"PSSOL",SOLAA,SZZ)) Q:'SZZ!($G(PSSOUT)) D
108 ..I ($Y+4)>IOSL D SOLH Q:$G(PSSOUT)
109 ..W !,"("_$G(SZZ)_") ",?13,$P($G(^PS(52.7,SZZ,0)),"^")_" ("_$P($G(^(0)),"^",3)_")"_$S($P($G(^("I")),"^")="":"",1:" ("_$E($P($G(^("I")),"^"),4,5)_"/"_$E($P($G(^("I")),"^"),6,7)_"/"_$E($P($G(^("I")),"^"),2,3)_")") W ?67,"(Solution)"
110 .Q:$G(PSSOUT)
111 .W !?2,"Dispense Drugs matched to OI:"
112 .F SLDD=0:0 S SLDD=$O(^PSDRUG("ASP",SSZZ,SLDD)) Q:'SLDD!($G(PSSOUT)) D
113 ..I ($Y+4)>IOSL D SOLH Q:$G(PSSOUT)
114 ..I $P($G(^PSDRUG(SLDD,"I")),"^"),$P($G(^("I")),"^")<$G(PSSYRX) Q
115 ..W !?11,$P($G(^PSDRUG(SLDD,0)),"^")_$S($P($G(^("I")),"^")="":"",1:" ("_$E($P($G(^("I")),"^"),4,5)_"/"_$E($P($G(^("I")),"^"),6,7)_"/"_$E($P($G(^("I")),"^"),2,3)_")")
116 I '$G(PSSOUT) D PDIR
117SEND ;
118 K ^TMP($J,"PSSOL")
119END I $G(PSSDV)="C" W !
120 E W @IOF
121 K PSSTOTAL,PSSIVID,PSSIVIDL,PSSTYPE,PSSDV,PSSWH,PSSCOT,PSSOUT,PSSCOTX,PSSADSUM,PSSSOSUM,PSSYRX
122 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
123ADDH ;
124 I $G(PSSCOT)=1 W @IOF W !?5,"ADDITIVE REPORT (Additive Internal number in parenthesis)",?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1 Q
125 I $G(PSSDV)="C" K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q
126 W @IOF W !?8,"ADDITIVE "_$S('$G(PSSADSUM):"REPORT",1:"SUMMARY")_" (continued)" W ?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1
127 Q
128ADDHS ;
129 I $G(PSSDV)="C" K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q
130 W @IOF W !!?5,"ADDITIVE SUMMARY" W ?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1
131 Q
132SOLH ;
133 I '$G(PSSCOTX) D Q:$G(PSSOUT) W @IOF W !?5,"SOLUTION REPORT (Solution Internal number in parenthesis)",?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1 Q
134 .I $G(PSSDV)="C",$G(PSSCOT)'=1 K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1
135 I $G(PSSDV)="C" K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q
136 W @IOF W !?8,"SOLUTION "_$S('$G(PSSSOSUM):"REPORT",1:"SUMMARY")_" (continued)" W ?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1
137 Q
138SOLHS ;
139 I $G(PSSDV)="C" K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q
140 W @IOF W !!?5,"SOLUTION SUMMARY" W ?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1
141 Q
142PDIR ;
143 Q:$G(PSSDV)'="C"
144 W ! S DIR(0)="E",DIR("A")="Pres Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1
145 Q
Note: See TracBrowser for help on using the repository browser.