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 Sep 23, 2025@20:03:14 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 ;
