- 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 Feb 18, 2025@23:53:38 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