source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCS2.m@ 802

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

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1PSUCS2 ;BIR/DJE,DJM - Generate CS records (TYPE2) ;25 AUG 1998
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIA's
5 ; Reference to File #58.81 supported by DBIA 2520
6 ; Reference to File #50 supported by DBIA 221
7 ; Reference to File #58.8 supported by DBIA 2519
8 ; Reference to File #59 supported by DBIA 2510
9 ;
10 ; *
11 ; TYPE 2 - "Dispensed from pharmacy"
12 ; *
13 ;
14TYP2 ; Processing the transaction for dispensing type 2
15 ;('logged for patient'). If the pharmacy location for transactions
16 ;with a dispensing type = 2 is associated with either an Outpatient
17 ; Or Inpatient site, it may be possible to break down the sender by
18 ;the outpatient clinic or inpatient division.
19 ;
20 K PSUQUIT
21 S PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,4)
22 ;
23 ;(type 2 specific call)
24 D QTY2
25 I 'PSUTQY(5) S PSUQUIT=1 Q ; do not send if QTY=0
26 ;
27 ; Unit cost
28 S PSUPDU(16)=$$VALI^PSUTL(50,PSUDRG(4),16)
29 ;
30 ; DIVISION
31 D DIVISION
32 ;
33 ;(Type 2 specific call)
34 D NAOU
35 ;
36 ;
37 ; Generic name, Location type.
38 D GNAME^PSUCS4,LOCTYP^PSUCS4
39 ;Requirement 3.2.5.7
40 I "SM"'[PSULTP(1) S PSUQUIT=1 Q ;**9
41 ;W PSULTP(1)
42 ;Requirement 3.2.5.8
43 I CPFLG="N" S PSUQUIT=1 Q ;**9
44 ;
45 ;VA Drug class, Formulary/Non-formulary, National formulary Indicator
46 D NDC^PSUCS4,FORMIND^PSUCS4,NFIND^PSUCS4
47 ;
48 ;
49 ; VA Product name, VA drug class, Package details.
50 D VPNAME^PSUCS4,VDC^PSUCS4,PDT^PSUCS4
51 ;
52 Q
53 ;
54 ;
55 ;
56 ;
57 ;
58DIVISION ;
59 ;Field # 58.81,2 [PHARMACY LOCATION] Points to File # 58.8
60 S PSUPL(2)=$$VALI^PSUTL(58.81,PSUIENDA,"2")
61 S SENDER=""
62 N MAPLOCI
63 D GETM^PSUTL(59.7,1,"90.02*^.01;.02;.03","MAPLOCI","I")
64 D MOVEMI^PSUTL("MAPLOCI")
65 ;
66 I $G(MAPLOCI(PSUPL(2),.01)) D
67 .S X=$G(MAPLOCI(PSUPL(2),.02)) I X S SENDER=$$VALI^PSUTL(40.8,X,1)
68 .S X=$G(MAPLOCI(PSUPL(2),.03)) I X S SENDER=$$VALI^PSUTL(59,X,.06)
69 I '$G(MAPLOCI(PSUPL(2),.01)) D
70 .S SENDER=PSUSNDR,PSURI="H"
71 Q
72 ;
73NAOU ;3.2.5.6. Functional Requirement 6
74 ;The product shall extract the NAOU if the dispensing type =2.
75 ;Field # 58.81,17 [NAOU] Points to File # 58.8
76 S PSUNAOU(17)=$$VALI^PSUTL(58.81,PSUIENDA,"17")
77 S PSUNAOU=PSUNAOU(17)
78 ;
79 ;If the NAOU does not exist for that transaction,
80 ;extract the Pharmacy PSULOCation.
81 ;Field # 58.81,2 [PHARMACY PSULOCATION] Points to File # 58.8
82 I PSUNAOU="" D
83 .S PSUNAOU(2)=$$VALI^PSUTL(58.81,PSUIENDA,"2")
84 .S PSUNAOU=PSUNAOU(2)
85 ;
86 ;Field # 58.8,.01 [PHARMACY PSULOCATION]***Field to be extracted
87 S PSUPLC(.01)=$$VALI^PSUTL(58.8,PSUNAOU,".01")
88 Q
89 ;
90QTY2 ;3.2.5.10. Functional Requirement 10
91 ;The product shall extract the total quantity dispensed.
92 ;For transactions with a dispensing type=2, check to see if
93 ;the quantity was edited (Field # 58.81,48).
94 ;If so, use the edited (new quantity).
95 ; if there is a date present then use the NEW QUANTITY value.
96 ;Field # 58.81,50 [NEW QUANTITY]**Field to be extracted
97 S PSUQED(48)=$$VALI^PSUTL(58.81,PSUIENDA,"48")
98 S PSUTQY(5)=$$VALI^PSUTL(58.81,PSUIENDA,5)
99 S:'PSUDRG(4) PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,4)
100 ;
101 I PSUQED(48) S PSUTQY(5)=$$VALI^PSUTL(58.81,PSUIENDA,50)
102 S:PSUTQY(5) ^XTMP(PSUCSJB,"TQTY",PSULOC,PSUIENDA,PSUDRG(4))=PSUTQY(5)
103 Q
104 ;
Note: See TracBrowser for help on using the repository browser.