| [613] | 1 | PSUCS2 ;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 | ;
|
|---|
| 14 | TYP2 ; 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 | ;
|
|---|
| 58 | DIVISION ;
|
|---|
| 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 | ;
|
|---|
| 73 | NAOU ;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 | ;
|
|---|
| 90 | QTY2 ;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 | ;
|
|---|
