source: FOIAVistA/tag/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50DOS.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1PSS50DOS ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;External reference to PS(50.607 supported by DBIA 2221
4SDOSE ;
5 N PSSZR,PSSZR1,PSSZRT,PSSZRT1
6 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
7 S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
8 S (PSSZR,PSSZR1)="" S PSSZR=$G(^TMP("PSSP50",$J,50,PSS(1),901,"I")) I PSSZR'="" S PSSZR1=$$LEAD(PSSZR)
9 S ^TMP($J,LIST,+PSS(1),901)=PSSZR1
10 S (PSSZRT,PSSZRT1)="" I $G(^TMP("PSSP50",$J,50,PSS(1),902,"I"))'="" S PSSZRT=$G(^TMP("PSSP50",$J,50,PSS(1),902,"E"))
11 I PSSZRT'="" S PSSZRT1=$$LEADU(PSSZRT)
12 S ^TMP($J,LIST,+PSS(1),902)=$S($G(^TMP("PSSP50",$J,50,PSS(1),902,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),902,"I"))_"^"_$G(PSSZRT1))
13 Q
14 ;
15SDOSE2 ;
16 N PSSPOSIO,PSSZR2,PSSZR3,PSSZR2T,PSSZR3T
17 S (PSSZR2,PSSZR2T)=""
18 S PSSZR2=$G(^TMP("PSSP50",$J,50.0903,PSS(2),.01,"I")) I PSSZR2'="" S PSSZR2T=$$LEAD(PSSZR2)
19 S ^TMP($J,LIST,+PSS(1),"POS",+PSS(2),.01)=PSSZR2T
20 S (PSSZR3,PSSZR3T)=""
21 S PSSZR3=$G(^TMP("PSSP50",$J,50.0903,PSS(2),1,"I")) I PSSZR3'="" S PSSZR3T=$$LEAD(PSSZR3)
22 S ^TMP($J,LIST,+PSS(1),"POS",+PSS(2),1)=PSSZR3T
23 S PSSPOSIO=$G(^TMP("PSSP50",$J,50.0903,PSS(2),2,"I"))
24 S ^TMP($J,LIST,+PSS(1),"POS",+PSS(2),2)=$S($G(PSSPOSIO)="":"",1:PSSPOSIO_"^"_$S(PSSPOSIO="I":"Inpatient",PSSPOSIO="O":"Outpatient",PSSPOSIO="IO":"Both",PSSPOSIO="OI":"Both",1:""))
25 S ^TMP($J,LIST,+PSS(1),"POS",+PSS(2),3)=$G(^TMP("PSSP50",$J,50.0903,PSS(2),3,"I"))
26 Q
27 ;
28SDOSE3 ;
29 S ^TMP($J,LIST,+PSS(1),"LOC",+PSS(2),.01)=$G(^TMP("PSSP50",$J,50.0904,PSS(2),.01,"I"))
30 S ^TMP($J,LIST,+PSS(1),"LOC",+PSS(2),1)=$S($G(^TMP("PSSP50",$J,50.0904,PSS(2),1,"I"))="":"",1:$G(^TMP("PSSP50",$J,50.0904,PSS(2),1,"I"))_"^"_$G(^TMP("PSSP50",$J,50.0904,PSS(2),1,"E")))
31 S ^TMP($J,LIST,+PSS(1),"LOC",+PSS(2),2)=$G(^TMP("PSSP50",$J,50.0904,PSS(2),2,"I"))
32 S ^TMP($J,LIST,+PSS(1),"LOC",+PSS(2),3)=$G(^TMP("PSSP50",$J,50.0904,PSS(2),3,"I"))
33 Q
34LOOP ;
35 N PSSENCT
36 S PSSENCT=0
37 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
38 .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
39 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
40 .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
41 .;Naked reference below refers to ^PSDRUG(PSS(1),2)
42 .I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^(2)),"^",3)[$E(PSSPK,PSSZ6) S PSSZ5=1
43 .I $G(PSSPK)]"",'PSSZ5 Q
44 .D SETSUB7^PSS50AQM(PSS(1)),SETSUB8^PSS50AQM(PSS(1))
45 .D SETLP1,SETLP2,SETLP3
46 .S PSSENCT=PSSENCT+1
47 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
48 Q
49SETLP1 ;
50 N PSSZNODE,PSS50NOD,PSSZR,PSSZR1,PSSZRT,PSSZRT1
51 S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50NOD=$G(^("DOS"))
52 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
53 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
54 S (PSSZR,PSSZR1)="" S PSSZR=$P(PSS50NOD,"^") I PSSZR'="" S PSSZR1=$$LEAD(PSSZR)
55 S ^TMP($J,LIST,+PSS(1),901)=PSSZR1
56 S (PSSZRT,PSSZRT1)="" I $P(PSS50NOD,"^",2) S PSSZRT=$P($G(^PS(50.607,+$P(PSS50NOD,"^",2),0)),"^")
57 I PSSZRT'="" S PSSZRT1=$$LEADU(PSSZRT)
58 S ^TMP($J,LIST,+PSS(1),902)=$S($P(PSS50NOD,"^",2):$P(PSS50NOD,"^",2)_"^"_PSSZRT1,1:"")
59 Q
60SETLP2 ;
61 N PSS903C,PSSZR5,PSSZR6,PSSZR7,PSSZR8 S PSS903C=0
62 I $O(^PSDRUG(PSS(1),"DOS1",0)) N PSS903,PSS903ND D
63 .F PSS903=0:0 S PSS903=$O(^PSDRUG(PSS(1),"DOS1",PSS903)) Q:'PSS903 D
64 ..S PSS903ND=$G(^PSDRUG(PSS(1),"DOS1",PSS903,0)) I $P(PSS903ND,"^")'="" S PSS903C=PSS903C+1 D
65 ...S (PSSZR5,PSSZR6)="" S PSSZR5=$P(PSS903ND,"^") I PSSZR5'="" S PSSZR6=$$LEAD(PSSZR5)
66 ...S ^TMP($J,LIST,+PSS(1),"POS",PSS903,.01)=PSSZR6
67 ...S (PSSZR7,PSSZR8)="" S PSSZR7=$P(PSS903ND,"^",2) I PSSZR7'="" S PSSZR8=$$LEAD(PSSZR7)
68 ...S ^TMP($J,LIST,+PSS(1),"POS",PSS903,1)=PSSZR8
69 ...N PSS903IO S PSS903IO=$P(PSS903ND,"^",3)
70 ...S ^TMP($J,LIST,+PSS(1),"POS",PSS903,2)=$S($G(PSS903IO)="":"",1:PSS903IO_"^"_$S(PSS903IO="I":"Inpatient",PSS903IO="O":"Outpatient",PSS903IO="IO":"Both",PSS903IO="OI":"Both",1:""))
71 ...S ^TMP($J,LIST,+PSS(1),"POS",PSS903,3)=$P(PSS903ND,"^",4)
72 S ^TMP($J,LIST,+PSS(1),"POS",0)=$S(PSS903C:PSS903C,1:"-1^NO DATA FOUND")
73 Q
74SETLP3 ;
75 N PSS904C S PSS904C=0
76 I $O(^PSDRUG(PSS(1),"DOS2",0)) N PSS904,PSS904ND D
77 .F PSS904=0:0 S PSS904=$O(^PSDRUG(PSS(1),"DOS2",PSS904)) Q:'PSS904 D
78 ..S PSS904ND=$G(^PSDRUG(PSS(1),"DOS2",PSS904,0)) I $P(PSS904ND,"^")'="" S PSS904C=PSS904C+1 D
79 ...S ^TMP($J,LIST,+PSS(1),"LOC",PSS904,.01)=$P(PSS904ND,"^")
80 ...N PSS904IO S PSS904IO=$P(PSS904ND,"^",2)
81 ...S ^TMP($J,LIST,+PSS(1),"LOC",PSS904,1)=$S($G(PSS904IO)="":"",1:PSS904IO_"^"_$S(PSS904IO="I":"Inpatient",PSS904IO="O":"Outpatient",PSS904IO="IO":"Both",PSS904IO="OI":"Both",1:""))
82 ...S ^TMP($J,LIST,+PSS(1),"LOC",PSS904,2)=$P(PSS904ND,"^",3)
83 ...S ^TMP($J,LIST,+PSS(1),"LOC",PSS904,3)=$P(PSS904ND,"^",4)
84 S ^TMP($J,LIST,+PSS(1),"LOC",0)=$S(PSS904C:PSS904C,1:"-1^NO DATA FOUND")
85 Q
86LEAD(PSSLEAD) ;Add leading zero to Dose, Dispense Units per Dose, and Strength
87 Q $S($E($G(PSSLEAD))=".":"0"_$G(PSSLEAD),1:$G(PSSLEAD))
88 Q
89LEADU(PSSLEADU) ;Add leading zero to Unit
90 N PSSLDU1,PSSLDU2,PSSLDU3
91 I PSSLEADU'["/" Q $S($E(PSSLEADU)=".":"0"_PSSLEADU,1:PSSLEADU)
92 S PSSLDU1=$P(PSSLEADU,"/"),PSSLDU2=$P(PSSLEADU,"/",2)
93 S PSSLDU1=$S($E(PSSLDU1)=".":"0"_PSSLDU1,1:PSSLDU1)
94 S PSSLDU2=$S($E(PSSLDU2)=".":"0"_PSSLDU2,1:PSSLDU2)
95 S PSSLD3=PSSLDU1_"/"_PSSLDU2
96 Q PSSLD3
97
Note: See TracBrowser for help on using the repository browser.