source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50AQM.m@ 1096

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

initial load of WorldVistAEHR
File size: 8.5 KB
Line 
1PSS50AQM ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,104**;9/30/97
3 ;External reference to PS(50.3 supported by DBIA 2127
4 ;External reference to PS(50.605 supported by DBIA 2138
5 ;External reference to PSNDF(50.6 supported by DBIA 2079
6 ;External reference to PSNDF(50.68 supported by DBIA 3735
7 ;
8SETALL ;
9 N PSSZNODE,PSS660,PSSNDNOD,PSS2NODE,PSSG2NOD S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS2NODE=$G(^(2)),PSS660=$G(^(660)),PSSG2NOD=$G(^("PSG")),PSSNDNOD=$G(^("ND"))
10 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
11 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
12 S ^TMP($J,LIST,+PSS(1),2)=$P(PSSZNODE,"^",2)
13 S ^TMP($J,LIST,+PSS(1),2.1)=$S('$P(PSS2NODE,"^"):"",1:$P(PSS2NODE,"^")_"^"_$P($G(^PS(50.7,+$P(PSS2NODE,"^"),0)),"^"))
14 N PSSADDF S PSSADDF=$P($G(^PS(50.7,+$P($G(^TMP($J,LIST,+PSS(1),2.1)),"^"),0)),"^",2) I PSSADDF>0 D
15 .S ^TMP($J,LIST,+PSS(1),2.1)=^TMP($J,LIST,+PSS(1),2.1)_"^"_PSSADDF_"^"_$P($G(^PS(50.606,PSSADDF,0)),"^")
16 S ^TMP($J,LIST,+PSS(1),3)=$P(PSSZNODE,"^",3)
17 S ^TMP($J,LIST,+PSS(1),4)=$P(PSSZNODE,"^",4)
18 S ^TMP($J,LIST,+PSS(1),5)=$P(PSSZNODE,"^",5)
19 S ^TMP($J,LIST,+PSS(1),6)=$P(PSSZNODE,"^",6)
20 S ^TMP($J,LIST,+PSS(1),8)=$P(PSSZNODE,"^",8)
21 S ^TMP($J,LIST,+PSS(1),12)=$S($P(PSS660,"^",2):$P(PSS660,"^",2)_"^"_$P($G(^DIC(51.5,+$P(PSS660,"^",2),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
22 S ^TMP($J,LIST,+PSS(1),13)=$P(PSS660,"^",3)
23 S ^TMP($J,LIST,+PSS(1),14.5)=$P(PSS660,"^",8)
24 S ^TMP($J,LIST,+PSS(1),15)=$P(PSS660,"^",5)
25 S ^TMP($J,LIST,+PSS(1),16)=$P(PSS660,"^",6)
26 S ^TMP($J,LIST,+PSS(1),20)=$S($P(PSSNDNOD,"^"):$P(PSSNDNOD,"^")_"^"_$P($G(^PSNDF(50.6,+$P(PSSNDNOD,"^"),0)),"^"),1:"")
27 S ^TMP($J,LIST,+PSS(1),21)=$P(PSSNDNOD,"^",2)
28 S ^TMP($J,LIST,+PSS(1),22)=$S($P(PSSNDNOD,"^",3):$P(PSSNDNOD,"^",3)_"^"_$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),0)),"^"),1:"")
29 S ^TMP($J,LIST,+PSS(1),25)=$S($P(PSSNDNOD,"^",6):$P(PSSNDNOD,"^",6)_"^"_$P($G(^PS(50.605,+$P(PSSNDNOD,"^",6),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
30 S ^TMP($J,LIST,+PSS(1),27)=$P(PSSNDNOD,"^",10)
31 S ^TMP($J,LIST,+PSS(1),31)=$P(PSS2NODE,"^",4)
32 S ^TMP($J,LIST,+PSS(1),40)=$P($G(^PSDRUG(PSS(1),"PSO")),"^")
33 N PSS51NF S PSS51NF=$P(PSSZNODE,"^",9) D
34 .I PSS51NF'="",PSS51NFD'="",PSS51NFD[(PSS51NF_":") S ^TMP($J,LIST,+PSS(1),51)=PSS51NF_"^"_$P($E(PSS51NFD,$F(PSS51NFD,(PSS51NF_":")),999),";") Q
35 .S ^TMP($J,LIST,+PSS(1),51)=""
36 N PSS52NF S PSS52NF=$P(PSSZNODE,"^",11) D
37 .I PSS52NF'="",PSS52NFD'="",PSS52NFD[(PSS52NF_":") S ^TMP($J,LIST,+PSS(1),52)=PSS52NF_"^"_$P($E(PSS52NFD,$F(PSS52NFD,(PSS52NF_":")),999),";") Q
38 .S ^TMP($J,LIST,+PSS(1),52)=""
39 S ^TMP($J,LIST,+PSS(1),63)=$P(PSS2NODE,"^",3)
40 S ^TMP($J,LIST,+PSS(1),64)=$S($P(PSS2NODE,"^",6):$P(PSS2NODE,"^",6)_"^"_$P($G(^PS(50.3,+$P(PSS2NODE,"^",6),0)),"^"),1:"")
41 N Y S Y=$P($G(^PSDRUG(PSS(1),"I")),"^") D
42 .I Y S ^TMP($J,LIST,+PSS(1),100)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,+PSS(1),100)=^TMP($J,LIST,+PSS(1),100)_"^"_$G(Y) Q
43 .S ^TMP($J,LIST,+PSS(1),100)=""
44 S ^TMP($J,LIST,+PSS(1),101)=$P(PSSZNODE,"^",10)
45 S ^TMP($J,LIST,+PSS(1),102)=$P(PSS2NODE,"^",2)
46 N PSSG2 S PSSG2=$P(PSSG2NOD,"^",2) D
47 .I PSSG2'="",PSSG2N'="",PSSG2N[(PSSG2_":") S ^TMP($J,LIST,+PSS(1),301)=PSSG2_"^"_$P($E(PSSG2N,$F(PSSG2N,(PSSG2_":")),999),";") Q
48 .S ^TMP($J,LIST,+PSS(1),301)=""
49 S ^TMP($J,LIST,+PSS(1),302)=$P(PSSG2NOD,"^",3)
50 ;Set new Service Code field
51 I $$PATCH^XPDUTL("PSS*1.0*92") D
52 .S ^TMP($J,LIST,+PSS(1),400)=$P($G(^PSDRUG(+PSS(1),"PFS")),"^")
53 .I $P(PSSNDNOD,"^",3),$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),"PFS")),"^")'="" S ^TMP($J,LIST,+PSS(1),400)=$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),"PFS")),"^")
54 .I $P($G(^TMP($J,LIST,+PSS(1),400)),"^")="" S ^TMP($J,LIST,+PSS(1),400)=600000
55 Q
56 ;
57 ;
58SETSYN ;
59 N PSS501C S PSS501C=0
60 I $O(^PSDRUG(PSS(1),1,0)) N PSS501,PSS501ND D
61 .F PSS501=0:0 S PSS501=$O(^PSDRUG(PSS(1),1,PSS501)) Q:'PSS501 D
62 ..S PSS501ND=$G(^PSDRUG(PSS(1),1,PSS501,0)) I $P(PSS501ND,"^")'="" S PSS501C=PSS501C+1 D
63 ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,.01)=$P(PSS501ND,"^")
64 ...N PSS501NN S PSS501NN=$P(PSS501ND,"^",3) D
65 ....I PSS501NN'="",PSS501NX'="",PSS501NX[(PSS501NN_":") S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,1)=PSS501NN_"^"_$P($E(PSS501NX,$F(PSS501NX,(PSS501NN_":")),999),";") Q
66 ....S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,1)=""
67 ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,2)=$P(PSS501ND,"^",2)
68 ...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,403)=$P(PSS501ND,"^",7)
69 S ^TMP($J,LIST,+PSS(1),"SYN",0)=$S(PSS501C:PSS501C,1:"-1^NO DATA FOUND")
70 Q
71 ;
72SETFMA ;
73 N PSS65C S PSS65C=0
74 I $O(^PSDRUG(PSS(1),65,0)) N PSS65,PSS65ND D
75 .F PSS65=0:0 S PSS65=$O(^PSDRUG(PSS(1),65,PSS65)) Q:'PSS65 D
76 ..S PSS65ND=$G(^PSDRUG(PSS(1),65,PSS65,0)) I $P(PSS65ND,"^") S PSS65C=PSS65C+1 D
77 ...S ^TMP($J,LIST,+PSS(1),"FRM",PSS65,.01)=$P(PSS65ND,"^")_"^"_$P($G(^PSDRUG(+$P(PSS65ND,"^"),0)),"^")
78 S ^TMP($J,LIST,+PSS(1),"FRM",0)=$S(PSS65C:PSS65C,1:"-1^NO DATA FOUND")
79 Q
80 ;
81SETOLD ;
82 N PSS900C S PSS900C=0
83 I $O(^PSDRUG(PSS(1),900,0)) N PSS900,PSS900ND D
84 .F PSS900=0:0 S PSS900=$O(^PSDRUG(PSS(1),900,PSS900)) Q:'PSS900 D
85 ..S PSS900ND=$G(^PSDRUG(PSS(1),900,PSS900,0)) I $P(PSS900ND,"^")'="" S PSS900C=PSS900C+1 D
86 ...S ^TMP($J,LIST,+PSS(1),"OLD",PSS900,.01)=$P(PSS900ND,"^")
87 ...N Y S Y=$P(PSS900ND,"^",2) I Y S ^TMP($J,LIST,+PSS(1),"OLD",PSS900,.02)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,+PSS(1),"OLD",PSS900,.02)=^TMP($J,LIST,+PSS(1),"OLD",PSS900,.02)_"^"_$G(Y)
88 S ^TMP($J,LIST,+PSS(1),"OLD",0)=$S(PSS900C:PSS900C,1:"-1^NO DATA FOUND")
89 Q
90SETSUB1(PSST1) ;Set sub-header nodes if there is data, and sub-header nodes do not exist
91 N PSST2,PSST3,PSST4
92 I $G(^PSDRUG(PSST1,1,0))="",$O(^PSDRUG(PSST1,1,0)) D
93 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,1,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,1,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
94 .I PSST4 S ^PSDRUG(PSST1,1,0)="^50.1A^"_PSST3_"^"_PSST4
95 Q
96SETSUB2(PSST1) ;
97 N PSST2,PSST3,PSST4
98 I $G(^PSDRUG(PSST1,65,0))="",$O(^PSDRUG(PSST1,65,0)) D
99 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,65,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,65,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
100 .I PSST4 S ^PSDRUG(PSST1,65,0)="^50.065P^"_PSST3_"^"_PSST4
101 Q
102SETSUB3(PSST1) ;
103 N PSST2,PSST3,PSST4
104 I $G(^PSDRUG(PSST1,900,0))="",$O(^PSDRUG(PSST1,900,0)) D
105 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,900,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,900,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
106 .I PSST4 S ^PSDRUG(PSST1,900,0)="^50.01A^"_PSST3_"^"_PSST4
107 Q
108SETSUB4(PSST1) ;
109 N PSST2,PSST3,PSST4
110 I $G(^PSDRUG(PSST1,441,0))="",$O(^PSDRUG(PSST1,441,0)) D
111 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,441,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,441,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
112 .I PSST4 S ^PSDRUG(PSST1,441,0)="^50.0441P^"_PSST3_"^"_PSST4
113 Q
114SETSUB5(PSST1) ;
115 N PSST2,PSST3,PSST4
116 I $G(^PSDRUG(PSST1,4,0))="",$O(^PSDRUG(PSST1,4,0)) D
117 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,4,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,4,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
118 .I PSST4 S ^PSDRUG(PSST1,4,0)="^50.0214DA^"_PSST3_"^"_PSST4
119 Q
120SETSUB6(PSST1) ;
121 N PSST2,PSST3,PSST4
122 I $G(^PSDRUG(PSST1,"CLOZ2",0))="",$O(^PSDRUG(PSST1,"CLOZ2",0)) D
123 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,"CLOZ2",PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,"CLOZ2",PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
124 .I PSST4 S ^PSDRUG(PSST1,"CLOZ2",0)="^50.02P^"_PSST3_"^"_PSST4
125 Q
126SETSUB7(PSST1) ;
127 N PSST2,PSST3,PSST4
128 I $G(^PSDRUG(PSST1,"DOS1",0))="",$O(^PSDRUG(PSST1,"DOS1",0)) D
129 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,"DOS1",PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,"DOS1",PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
130 .I PSST4 S ^PSDRUG(PSST1,"DOS1",0)="^50.0903^"_PSST3_"^"_PSST4
131 Q
132SETSUB8(PSST1) ;
133 N PSST2,PSST3,PSST4
134 I $G(^PSDRUG(PSST1,"DOS2",0))="",$O(^PSDRUG(PSST1,"DOS2",0)) D
135 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,"DOS2",PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,"DOS2",PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
136 .I PSST4 S ^PSDRUG(PSST1,"DOS2",0)="^50.0904^"_PSST3_"^"_PSST4
137 Q
138SETSUB9(PSST1) ;
139 N PSST2,PSST3,PSST4
140 I $G(^PSDRUG(PSST1,212,0))="",$O(^PSDRUG(PSST1,212,0)) D
141 .S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,212,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,212,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
142 .I PSST4 S ^PSDRUG(PSST1,212,0)="^50.0212P^"_PSST3_"^"_PSST4
143 Q
144SETDF(PSSIEN) ;
145 ;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
146 ;Returns NAME field (#.01) of PHARMACY ORDERABLE ITEM file (#50.7) and DOSAGE FORM
147 N DIERR,ZZERR,PSS50P7,PSS
148 I +$G(PSSIEN)'>0 Q -1_"^"_"NO DATA FOUND"
149 D GETS^DIQ(50.7,+PSSIEN,".01;.02","IE","PSS50P7")
150 I '$D(PSS50P7) Q -1_"^"_"NO DATA FOUND"
151 Q $G(PSSIEN)_"^"_$G(PSS50P7(50.7,PSSIEN_",",.01,"I"))_"^"_$G(PSS50P7(50.7,PSSIEN_",",.02,"I"))_"^"_$G(PSS50P7(50.7,PSSIEN_",",.02,"E"))
Note: See TracBrowser for help on using the repository browser.