PSUCS3 ;BIR/DJE,DJM - GENERATE PSU CS RECORDS (TYPE 17) ;25 AUG 1998
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;DBIA'S
; Reference to file #40.8 supported by DBIA 2438
; Reference to file #58.81 supported by DBIA 2520
; Reference to file #50 supported by DBIA 221
; Reference to file #42 supported by DBIA 1848
; Reference to file #2 supported by DBIA 10035
; Reference to file #58.8 supported by DBIA 2519
; ***
; TYPE 17 - "Logged for patient"
; ***
;
TYP17 ; Processing the transaction for dispensing type 17
;('logged for patient'). If the dispensing type=17 and a patient IEN
;is identified, one can use this information one find the ward location
;if the patient is still an inpatient when the extract is done.
D FACILTY
;
; (type 17 specific call)
; Patient SSN
D SSN
;
; Generic name, Location type.
D GNAME^PSUCS4,LOCTYP^PSUCS4
; Requirement 3.2.5.7
Q:"N"'[PSULTP(1)
;
; check if drug administered multiple times for a patient
D MULTCHK
;
;VA Drug class, Formulary/Non-formulary, National formulary Indicator.
D NDC^PSUCS4,FORMIND^PSUCS4,NFIND^PSUCS4
;
;(type 17 specific call)
; Dispense unit, unit cost, Quantity
D DUNIT,UNITC,QTY17
;
; VA Product name, VA drug class, Packaging
D VPNAME^PSUCS4,VDC^PSUCS4
;
Q
;
;
;
; Type 17 specific calls
;
;
MULTCHK ;
; store in array (quit if already administered)
S PSUMCHK=0
S PSUQT(5)=$$VALI^PSUTL(58.81,PSUIENDA,5)
; if patient,drug collection started increment QT
I $D(^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4))) D Q
. S X=^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4),"QT")
. S ^("QT")=X+PSUQT(5)
; Save the IEN of the first transaction for collection
;S PSUMCIEN=PSUIENDA
; start patient drug collection
S ^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4))=PSUIENDA
S ^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4),"QT")=PSUQT(5)
Q
;
FACILTY ;
;Field # 2,.1[WARD LOCATION]
S PSUWLC(.01)=$$VALI^PSUTL(2,PSUPIEN(73),".01")
Q:PSUWLC(.01)=""
S PSUWLC(.01)=$O(^DIC(42,"B",PSUWLC(.01),""))
Q:PSUWLC(.01)=""
;
;Field # 58.842,.01 [WARD] Points to File # 42
S PSUWARD(1)=$$VALI^PSUTL(58.842,PSUWLC(.01),"1")
;D GETS^PSUTL(58.842,PSUWLC(.1),"1","PSUWARD","I")
;D MOVEI^PSUTL("PSUWARD")
;
;Field # 42,.015 [DIVISION] Points to File # 40.8
S PSUDIV(.015)=$$VALI^PSUTL(42,PSUWARD(1),".015")
;
;Field # 40.8,1 [FACILITY NUMBER]**Field to be extracted
S PSUFCN(1)=$$VALI^PSUTL(40.8,PSUDIV(.015),"1")
S SENDER=PSUFCN(1)
S PSURI=""
Q
;
SSN ;Field # 58.81,73 [PATIENT] Points to File # 2
;Field # 2,.09 [SOCIAL SECURITY NUMBER]**Field to be extracted
Q:$G(PSUPIEN(73))=""
S DFN=PSUPIEN(73) D PID^VADPT
S PSUSSN(.09)=$TR(VA("PID"),"-","")
Q
;
DUNIT ;Dispense Unit
;Field # 50,14.5 [DISPENSE UNIT]**Field to be extracted
S PSUDUN(14.5)=$$VALI^PSUTL(50,PSUDRG(4),"14.5")
S UNIT=PSUDUN(14.5)
Q
;
UNITC ;Unit Cost
;Field # 50,16 [PRICE PER DISPENSE UNIT]**Field to be extracted
S PSUPDU(16)=$$VALI^PSUTL(50,PSUDRG(4),"16")
Q
;
QTY17 ;For transactions with a dispensing type =17, total the number of doses
;dispensed for the same drug (Field # 58.81,4), regardless of the date
;dispensed within the reporting month. The dispensed (transaction) date
;will be the date the first dose was administered to the patient during
;the reporting period. The data will be transmitted as a single data
;record.
;Sum of Values # 58.81,5 [TOTAL QUANTITY]**Field to be extracted
Q ;this is handled in gathering into "MC"
S PSUTQ(5)=$$VALI^PSUTL(58.81,PSUIENDA,5)
S OLDXTMP=$G(^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4)),"QT")
S ^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4),"QT")=OLDXTMP+PSUTQ(5)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUCS3 3824 printed Sep 23, 2025@20:03:15 Page 2
PSUCS3 ;BIR/DJE,DJM - GENERATE PSU CS RECORDS (TYPE 17) ;25 AUG 1998
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;DBIA'S
+4 ; Reference to file #40.8 supported by DBIA 2438
+5 ; Reference to file #58.81 supported by DBIA 2520
+6 ; Reference to file #50 supported by DBIA 221
+7 ; Reference to file #42 supported by DBIA 1848
+8 ; Reference to file #2 supported by DBIA 10035
+9 ; Reference to file #58.8 supported by DBIA 2519
+10 ; ***
+11 ; TYPE 17 - "Logged for patient"
+12 ; ***
+13 ;
TYP17 ; Processing the transaction for dispensing type 17
+1 ;('logged for patient'). If the dispensing type=17 and a patient IEN
+2 ;is identified, one can use this information one find the ward location
+3 ;if the patient is still an inpatient when the extract is done.
+4 DO FACILTY
+5 ;
+6 ; (type 17 specific call)
+7 ; Patient SSN
+8 DO SSN
+9 ;
+10 ; Generic name, Location type.
+11 DO GNAME^PSUCS4
DO LOCTYP^PSUCS4
+12 ; Requirement 3.2.5.7
+13 if "N"'[PSULTP(1)
QUIT
+14 ;
+15 ; check if drug administered multiple times for a patient
+16 DO MULTCHK
+17 ;
+18 ;VA Drug class, Formulary/Non-formulary, National formulary Indicator.
+19 DO NDC^PSUCS4
DO FORMIND^PSUCS4
DO NFIND^PSUCS4
+20 ;
+21 ;(type 17 specific call)
+22 ; Dispense unit, unit cost, Quantity
+23 DO DUNIT
DO UNITC
DO QTY17
+24 ;
+25 ; VA Product name, VA drug class, Packaging
+26 DO VPNAME^PSUCS4
DO VDC^PSUCS4
+27 ;
+28 QUIT
+29 ;
+30 ;
+31 ;
+32 ; Type 17 specific calls
+33 ;
+34 ;
MULTCHK ;
+1 ; store in array (quit if already administered)
+2 SET PSUMCHK=0
+3 SET PSUQT(5)=$$VALI^PSUTL(58.81,PSUIENDA,5)
+4 ; if patient,drug collection started increment QT
+5 IF $DATA(^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4)))
Begin DoDot:1
+6 SET X=^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4),"QT")
+7 SET ^("QT")=X+PSUQT(5)
End DoDot:1
QUIT
+8 ; Save the IEN of the first transaction for collection
+9 ;S PSUMCIEN=PSUIENDA
+10 ; start patient drug collection
+11 SET ^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4))=PSUIENDA
+12 SET ^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4),"QT")=PSUQT(5)
+13 QUIT
+14 ;
FACILTY ;
+1 ;Field # 2,.1[WARD LOCATION]
+2 SET PSUWLC(.01)=$$VALI^PSUTL(2,PSUPIEN(73),".01")
+3 if PSUWLC(.01)=""
QUIT
+4 SET PSUWLC(.01)=$ORDER(^DIC(42,"B",PSUWLC(.01),""))
+5 if PSUWLC(.01)=""
QUIT
+6 ;
+7 ;Field # 58.842,.01 [WARD] Points to File # 42
+8 SET PSUWARD(1)=$$VALI^PSUTL(58.842,PSUWLC(.01),"1")
+9 ;D GETS^PSUTL(58.842,PSUWLC(.1),"1","PSUWARD","I")
+10 ;D MOVEI^PSUTL("PSUWARD")
+11 ;
+12 ;Field # 42,.015 [DIVISION] Points to File # 40.8
+13 SET PSUDIV(.015)=$$VALI^PSUTL(42,PSUWARD(1),".015")
+14 ;
+15 ;Field # 40.8,1 [FACILITY NUMBER]**Field to be extracted
+16 SET PSUFCN(1)=$$VALI^PSUTL(40.8,PSUDIV(.015),"1")
+17 SET SENDER=PSUFCN(1)
+18 SET PSURI=""
+19 QUIT
+20 ;
SSN ;Field # 58.81,73 [PATIENT] Points to File # 2
+1 ;Field # 2,.09 [SOCIAL SECURITY NUMBER]**Field to be extracted
+2 if $GET(PSUPIEN(73))=""
QUIT
+3 SET DFN=PSUPIEN(73)
DO PID^VADPT
+4 SET PSUSSN(.09)=$TRANSLATE(VA("PID"),"-","")
+5 QUIT
+6 ;
DUNIT ;Dispense Unit
+1 ;Field # 50,14.5 [DISPENSE UNIT]**Field to be extracted
+2 SET PSUDUN(14.5)=$$VALI^PSUTL(50,PSUDRG(4),"14.5")
+3 SET UNIT=PSUDUN(14.5)
+4 QUIT
+5 ;
UNITC ;Unit Cost
+1 ;Field # 50,16 [PRICE PER DISPENSE UNIT]**Field to be extracted
+2 SET PSUPDU(16)=$$VALI^PSUTL(50,PSUDRG(4),"16")
+3 QUIT
+4 ;
QTY17 ;For transactions with a dispensing type =17, total the number of doses
+1 ;dispensed for the same drug (Field # 58.81,4), regardless of the date
+2 ;dispensed within the reporting month. The dispensed (transaction) date
+3 ;will be the date the first dose was administered to the patient during
+4 ;the reporting period. The data will be transmitted as a single data
+5 ;record.
+6 ;Sum of Values # 58.81,5 [TOTAL QUANTITY]**Field to be extracted
+7 ;this is handled in gathering into "MC"
QUIT
+8 SET PSUTQ(5)=$$VALI^PSUTL(58.81,PSUIENDA,5)
+9 SET OLDXTMP=$GET(^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4)),"QT")
+10 SET ^XTMP(PSUCSJB,"MC",PSULOC,PSUPIEN(73),PSUDRG(4),"QT")=OLDXTMP+PSUTQ(5)
+11 QUIT
