- PSUCS2 ;BIR/DJE,DJM - Generate CS records (TYPE2) ;25 AUG 1998
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;
- ;DBIA's
- ; Reference to File #58.81 supported by DBIA 2520
- ; Reference to File #50 supported by DBIA 221
- ; Reference to File #58.8 supported by DBIA 2519
- ; Reference to File #59 supported by DBIA 2510
- ;
- ; *
- ; TYPE 2 - "Dispensed from pharmacy"
- ; *
- ;
- TYP2 ; Processing the transaction for dispensing type 2
- ;('logged for patient'). If the pharmacy location for transactions
- ;with a dispensing type = 2 is associated with either an Outpatient
- ; Or Inpatient site, it may be possible to break down the sender by
- ;the outpatient clinic or inpatient division.
- ;
- K PSUQUIT
- S PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,4)
- ;
- ;(type 2 specific call)
- D QTY2
- I 'PSUTQY(5) S PSUQUIT=1 Q ; do not send if QTY=0
- ;
- ; Unit cost
- S PSUPDU(16)=$$VALI^PSUTL(50,PSUDRG(4),16)
- ;
- ; DIVISION
- D DIVISION
- ;
- ;(Type 2 specific call)
- D NAOU
- ;
- ;
- ; Generic name, Location type.
- D GNAME^PSUCS4,LOCTYP^PSUCS4
- ;Requirement 3.2.5.7
- I "SM"'[PSULTP(1) S PSUQUIT=1 Q ;**9
- ;W PSULTP(1)
- ;Requirement 3.2.5.8
- I CPFLG="N" S PSUQUIT=1 Q ;**9
- ;
- ;VA Drug class, Formulary/Non-formulary, National formulary Indicator
- D NDC^PSUCS4,FORMIND^PSUCS4,NFIND^PSUCS4
- ;
- ;
- ; VA Product name, VA drug class, Package details.
- D VPNAME^PSUCS4,VDC^PSUCS4,PDT^PSUCS4
- ;
- Q
- ;
- ;
- ;
- ;
- ;
- DIVISION ;
- ;Field # 58.81,2 [PHARMACY LOCATION] Points to File # 58.8
- S PSUPL(2)=$$VALI^PSUTL(58.81,PSUIENDA,"2")
- S SENDER=""
- N MAPLOCI
- D GETM^PSUTL(59.7,1,"90.02*^.01;.02;.03","MAPLOCI","I")
- D MOVEMI^PSUTL("MAPLOCI")
- ;
- I $G(MAPLOCI(PSUPL(2),.01)) D
- .S X=$G(MAPLOCI(PSUPL(2),.02)) I X S SENDER=$$VALI^PSUTL(40.8,X,1)
- .S X=$G(MAPLOCI(PSUPL(2),.03)) I X S SENDER=$$VALI^PSUTL(59,X,.06)
- I '$G(MAPLOCI(PSUPL(2),.01)) D
- .S SENDER=PSUSNDR,PSURI="H"
- Q
- ;
- NAOU ;3.2.5.6. Functional Requirement 6
- ;The product shall extract the NAOU if the dispensing type =2.
- ;Field # 58.81,17 [NAOU] Points to File # 58.8
- S PSUNAOU(17)=$$VALI^PSUTL(58.81,PSUIENDA,"17")
- S PSUNAOU=PSUNAOU(17)
- ;
- ;If the NAOU does not exist for that transaction,
- ;extract the Pharmacy PSULOCation.
- ;Field # 58.81,2 [PHARMACY PSULOCATION] Points to File # 58.8
- I PSUNAOU="" D
- .S PSUNAOU(2)=$$VALI^PSUTL(58.81,PSUIENDA,"2")
- .S PSUNAOU=PSUNAOU(2)
- ;
- ;Field # 58.8,.01 [PHARMACY PSULOCATION]***Field to be extracted
- S PSUPLC(.01)=$$VALI^PSUTL(58.8,PSUNAOU,".01")
- Q
- ;
- QTY2 ;3.2.5.10. Functional Requirement 10
- ;The product shall extract the total quantity dispensed.
- ;For transactions with a dispensing type=2, check to see if
- ;the quantity was edited (Field # 58.81,48).
- ;If so, use the edited (new quantity).
- ; if there is a date present then use the NEW QUANTITY value.
- ;Field # 58.81,50 [NEW QUANTITY]**Field to be extracted
- S PSUQED(48)=$$VALI^PSUTL(58.81,PSUIENDA,"48")
- S PSUTQY(5)=$$VALI^PSUTL(58.81,PSUIENDA,5)
- S:'PSUDRG(4) PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,4)
- ;
- I PSUQED(48) S PSUTQY(5)=$$VALI^PSUTL(58.81,PSUIENDA,50)
- S:PSUTQY(5) ^XTMP(PSUCSJB,"TQTY",PSULOC,PSUIENDA,PSUDRG(4))=PSUTQY(5)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUCS2 3250 printed Feb 18, 2025@23:53:37 Page 2
- PSUCS2 ;BIR/DJE,DJM - Generate CS records (TYPE2) ;25 AUG 1998
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ;
- +3 ;DBIA's
- +4 ; Reference to File #58.81 supported by DBIA 2520
- +5 ; Reference to File #50 supported by DBIA 221
- +6 ; Reference to File #58.8 supported by DBIA 2519
- +7 ; Reference to File #59 supported by DBIA 2510
- +8 ;
- +9 ; *
- +10 ; TYPE 2 - "Dispensed from pharmacy"
- +11 ; *
- +12 ;
- TYP2 ; Processing the transaction for dispensing type 2
- +1 ;('logged for patient'). If the pharmacy location for transactions
- +2 ;with a dispensing type = 2 is associated with either an Outpatient
- +3 ; Or Inpatient site, it may be possible to break down the sender by
- +4 ;the outpatient clinic or inpatient division.
- +5 ;
- +6 KILL PSUQUIT
- +7 SET PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,4)
- +8 ;
- +9 ;(type 2 specific call)
- +10 DO QTY2
- +11 ; do not send if QTY=0
- IF 'PSUTQY(5)
- SET PSUQUIT=1
- QUIT
- +12 ;
- +13 ; Unit cost
- +14 SET PSUPDU(16)=$$VALI^PSUTL(50,PSUDRG(4),16)
- +15 ;
- +16 ; DIVISION
- +17 DO DIVISION
- +18 ;
- +19 ;(Type 2 specific call)
- +20 DO NAOU
- +21 ;
- +22 ;
- +23 ; Generic name, Location type.
- +24 DO GNAME^PSUCS4
- DO LOCTYP^PSUCS4
- +25 ;Requirement 3.2.5.7
- +26 ;**9
- IF "SM"'[PSULTP(1)
- SET PSUQUIT=1
- QUIT
- +27 ;W PSULTP(1)
- +28 ;Requirement 3.2.5.8
- +29 ;**9
- IF CPFLG="N"
- SET PSUQUIT=1
- QUIT
- +30 ;
- +31 ;VA Drug class, Formulary/Non-formulary, National formulary Indicator
- +32 DO NDC^PSUCS4
- DO FORMIND^PSUCS4
- DO NFIND^PSUCS4
- +33 ;
- +34 ;
- +35 ; VA Product name, VA drug class, Package details.
- +36 DO VPNAME^PSUCS4
- DO VDC^PSUCS4
- DO PDT^PSUCS4
- +37 ;
- +38 QUIT
- +39 ;
- +40 ;
- +41 ;
- +42 ;
- +43 ;
- DIVISION ;
- +1 ;Field # 58.81,2 [PHARMACY LOCATION] Points to File # 58.8
- +2 SET PSUPL(2)=$$VALI^PSUTL(58.81,PSUIENDA,"2")
- +3 SET SENDER=""
- +4 NEW MAPLOCI
- +5 DO GETM^PSUTL(59.7,1,"90.02*^.01;.02;.03","MAPLOCI","I")
- +6 DO MOVEMI^PSUTL("MAPLOCI")
- +7 ;
- +8 IF $GET(MAPLOCI(PSUPL(2),.01))
- Begin DoDot:1
- +9 SET X=$GET(MAPLOCI(PSUPL(2),.02))
- IF X
- SET SENDER=$$VALI^PSUTL(40.8,X,1)
- +10 SET X=$GET(MAPLOCI(PSUPL(2),.03))
- IF X
- SET SENDER=$$VALI^PSUTL(59,X,.06)
- End DoDot:1
- +11 IF '$GET(MAPLOCI(PSUPL(2),.01))
- Begin DoDot:1
- +12 SET SENDER=PSUSNDR
- SET PSURI="H"
- End DoDot:1
- +13 QUIT
- +14 ;
- NAOU ;3.2.5.6. Functional Requirement 6
- +1 ;The product shall extract the NAOU if the dispensing type =2.
- +2 ;Field # 58.81,17 [NAOU] Points to File # 58.8
- +3 SET PSUNAOU(17)=$$VALI^PSUTL(58.81,PSUIENDA,"17")
- +4 SET PSUNAOU=PSUNAOU(17)
- +5 ;
- +6 ;If the NAOU does not exist for that transaction,
- +7 ;extract the Pharmacy PSULOCation.
- +8 ;Field # 58.81,2 [PHARMACY PSULOCATION] Points to File # 58.8
- +9 IF PSUNAOU=""
- Begin DoDot:1
- +10 SET PSUNAOU(2)=$$VALI^PSUTL(58.81,PSUIENDA,"2")
- +11 SET PSUNAOU=PSUNAOU(2)
- End DoDot:1
- +12 ;
- +13 ;Field # 58.8,.01 [PHARMACY PSULOCATION]***Field to be extracted
- +14 SET PSUPLC(.01)=$$VALI^PSUTL(58.8,PSUNAOU,".01")
- +15 QUIT
- +16 ;
- QTY2 ;3.2.5.10. Functional Requirement 10
- +1 ;The product shall extract the total quantity dispensed.
- +2 ;For transactions with a dispensing type=2, check to see if
- +3 ;the quantity was edited (Field # 58.81,48).
- +4 ;If so, use the edited (new quantity).
- +5 ; if there is a date present then use the NEW QUANTITY value.
- +6 ;Field # 58.81,50 [NEW QUANTITY]**Field to be extracted
- +7 SET PSUQED(48)=$$VALI^PSUTL(58.81,PSUIENDA,"48")
- +8 SET PSUTQY(5)=$$VALI^PSUTL(58.81,PSUIENDA,5)
- +9 if 'PSUDRG(4)
- SET PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,4)
- +10 ;
- +11 IF PSUQED(48)
- SET PSUTQY(5)=$$VALI^PSUTL(58.81,PSUIENDA,50)
- +12 if PSUTQY(5)
- SET ^XTMP(PSUCSJB,"TQTY",PSULOC,PSUIENDA,PSUDRG(4))=PSUTQY(5)
- +13 QUIT
- +14 ;