PSUCS4 ;BIR/DJE - PBM CS GENERATE RECORDS ;13 OCT 1999
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
; **
; General Calls from type 2 & 17
; **
;DBIAs
; Reference to file #50 supported by DBIA 221
; Reference to file #58.8 supported by DBIA 2519
; Reference to file #58.81 supported by DBIA 2520
;
GNAME ;3.2.5.11. Functional Requirement 11
;Field # 58.81,4 [DRUG] Points to File # 50
S PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,"4")
;
;Generic Drug Name
;Field # 50,.01 [GENERIC NAME]**Field to be extracted
S PSUGDN(.01)=$$VALI^PSUTL(50,PSUDRG(4),".01")
I $G(PSUGDN(.01))="" S PSUGDN(.01)="Unknown Generic Name"
Q
;
LOCTYP ;3.2.5.7. Functional Requirement 7
;Transactions with a dispensing type (field # 58.81,1) of '2'
; - Dispensed from Pharmacy must be associated with a location type
;(field # 58.8,1) of 'M' for Master or 'S' for Satellite.
;Transactions with a dispensing type (field # 58.81,1) of '17'
;- Logged for Patient must be associated with a location type
;(field # 58.8,1) of 'N' for narcotic location.
;S PSULTP(1)=$$VALI^PSUTL(58.81,PSUIENDA,"1")
;D MOVEI^PSUTL("PSULTP")
S PSULTP(1)=$$VALI^PSUTL(58.8,PSULOC,1)
Q:PSUTYP=17
;
;3.2.5.8. Functional Requirement 8
;Transactions with a dispensing type '2'-dispensed from pharmacy
;(field # 58.81,1) and a Location type of 'M' for 'S' (field # 58.8,1)
;
; Continue Processing Flag (CPFLG)
S CPFLG="Y"
; but that have been cancelled (field # 58.81,55) will be excluded.
; (ie.If there is a 'cancel verified order date' - PSUCDT)
S PSUCDT(55)=$$VALI^PSUTL(58.81,PSUIENDA,"55")
Q:$G(PSUCDT(55))=""
S CPFLG="N"
Q
;
;3.2.5.9. Functional Requirement 9
;Dispensing transactions that meet the criteria in functional
;requirements 3.2.5.3., 3.2.5.7. and 3.2.5.8. will have the following
;additional data elements for the drug extracted.
;
NDC ;NDC
;Field # 50,31 [NDC]**Field to be extracted
;If no data found, send "No NDC".
S PSUNDC(31)=$$VALI^PSUTL(50,PSUDRG(4),"31")
I $G(PSUNDC(31))="" S PSUNDC(31)="No NDC"
Q
;
;
FORMIND ;Formulary/Non-Formulary Indicator
;Field # 50,51 [NON-FORMULARY]**Field to be extracted
S PSUFID(51)=$$VALI^PSUTL(50,PSUDRG(4),"51")
Q
;
NFIND ;National Formulary Indicator
;Product will need to check whether or not Vs 4.0 of
;National Drug File is installed. If not, this field will not exist.
;Check for National Drug File
S (NFIND,NFRES)=""
S VERSION=$$VERSION^XPDUTL("PSN")
Q:VERSION<4.0
;Field # 50.68,17 [NATIONAL FORMULARY INDICATOR]***Field to be extracted
;If National Drug File vs 4.0 is not installed
;Transmission format: Send null
;If National Drug File vs 4.0 is installed
S PSUDRG4=PSUDRG(4)
D GETS^PSUTL(50,PSUDRG4,"20;22;3;52","PSUDRG","I")
D MOVEI^PSUTL("PSUDRG")
S PSUDRG(4)=PSUDRG4
;
S PSUNFI(17)=$$FORMI^PSNAPIS(PSUDRG(20),PSUDRG(22))
;Transmission format: Internal value ('1' for Yes, '0' for No)
;National Formulary Restriction Indicator
;Product shall check whether or not Vs 4.0 of National Drug File
;is installed. If not, this field will not exist.
;Field #50.6818,.01[NATIONAL FORMULARY RESTRICTION]Field to be extracted
;
S PSUNFR(.01)=$$FORMR^PSNAPIS(PSUDRG(20),PSUDRG(22))>0
S PSUNFR(.01)=$S($G(PSUNFR(.01))="":0,1:PSUNFR(.01))
;
;If National Drug File vs 4.0 is not installed
;Transmission format: Send null
;If National Drug File vs 4.0 is installed
;Transmission format: If no value is found send '0',
;if data exists sent '1'
Q
;
VPNAME ;VA Product Name
;Field # 50,21[VA PRODUCT NAME]**Field to be extracted
S PSUVPN(21)=$$VALI^PSUTL(50,PSUDRG(4),"21")
S PSUDRG4=PSUDRG(4) ;if no value found, send "Unknown VA Product Name"
I $G(PSUVPN(21))="" S PSUVPN(21)="Unknown VA Product Name"
D GETS^PSUTL(50,PSUDRG(4),"3;52","PSUDRG","I"),MOVEI^PSUTL("PSUDRG")
S PSUDRG(4)=PSUDRG4 ;DEA, NFI
Q
;
VDC ; VA Drug Class
;Field # 50,2 [NATIONAL DRUG CLASS] Pointer to File # 50.605
;used DRUG pointer from previous quantity check.
S PSUNAC(2)=$$VALI^PSUTL(50,PSUDRG(4),"2")
;
;Field # 50.605,.01 [CODE]**Field to be extracted
S PSUFID(.01)=PSUNAC(2)
Q
;Field # 58.8001,.01 [DRUG] Pointer to File # 50
;
PDT ;Package details
;Field # 58.8001,7 [BREAKDOWN UNIT]**Field to be extracted
;Field # 58.8001,8 [PACKAGE SIZE]**Field to be extracted
S PSUSITE=0
S PSUSITE=$$VALI^PSUTL(58.8,PSUIENDA,20)
S:'PSUSITE PSUSITE=$$VALI^PSUTL(58.81,PSUIENDA,2)
D GETS^PSUTL(58.8001,"PSUSITE,PSUDRG(4)","7;8","PSUPDT","I")
D MOVEI^PSUTL("PSUPDT")
S UNIT=$G(PSUPDT(7),"NA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUCS4 4657 printed Sep 23, 2025@20:03:16 Page 2
PSUCS4 ;BIR/DJE - PBM CS GENERATE RECORDS ;13 OCT 1999
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ; **
+4 ; General Calls from type 2 & 17
+5 ; **
+6 ;DBIAs
+7 ; Reference to file #50 supported by DBIA 221
+8 ; Reference to file #58.8 supported by DBIA 2519
+9 ; Reference to file #58.81 supported by DBIA 2520
+10 ;
GNAME ;3.2.5.11. Functional Requirement 11
+1 ;Field # 58.81,4 [DRUG] Points to File # 50
+2 SET PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,"4")
+3 ;
+4 ;Generic Drug Name
+5 ;Field # 50,.01 [GENERIC NAME]**Field to be extracted
+6 SET PSUGDN(.01)=$$VALI^PSUTL(50,PSUDRG(4),".01")
+7 IF $GET(PSUGDN(.01))=""
SET PSUGDN(.01)="Unknown Generic Name"
+8 QUIT
+9 ;
LOCTYP ;3.2.5.7. Functional Requirement 7
+1 ;Transactions with a dispensing type (field # 58.81,1) of '2'
+2 ; - Dispensed from Pharmacy must be associated with a location type
+3 ;(field # 58.8,1) of 'M' for Master or 'S' for Satellite.
+4 ;Transactions with a dispensing type (field # 58.81,1) of '17'
+5 ;- Logged for Patient must be associated with a location type
+6 ;(field # 58.8,1) of 'N' for narcotic location.
+7 ;S PSULTP(1)=$$VALI^PSUTL(58.81,PSUIENDA,"1")
+8 ;D MOVEI^PSUTL("PSULTP")
+9 SET PSULTP(1)=$$VALI^PSUTL(58.8,PSULOC,1)
+10 if PSUTYP=17
QUIT
+11 ;
+12 ;3.2.5.8. Functional Requirement 8
+13 ;Transactions with a dispensing type '2'-dispensed from pharmacy
+14 ;(field # 58.81,1) and a Location type of 'M' for 'S' (field # 58.8,1)
+15 ;
+16 ; Continue Processing Flag (CPFLG)
+17 SET CPFLG="Y"
+18 ; but that have been cancelled (field # 58.81,55) will be excluded.
+19 ; (ie.If there is a 'cancel verified order date' - PSUCDT)
+20 SET PSUCDT(55)=$$VALI^PSUTL(58.81,PSUIENDA,"55")
+21 if $GET(PSUCDT(55))=""
QUIT
+22 SET CPFLG="N"
+23 QUIT
+24 ;
+25 ;3.2.5.9. Functional Requirement 9
+26 ;Dispensing transactions that meet the criteria in functional
+27 ;requirements 3.2.5.3., 3.2.5.7. and 3.2.5.8. will have the following
+28 ;additional data elements for the drug extracted.
+29 ;
NDC ;NDC
+1 ;Field # 50,31 [NDC]**Field to be extracted
+2 ;If no data found, send "No NDC".
+3 SET PSUNDC(31)=$$VALI^PSUTL(50,PSUDRG(4),"31")
+4 IF $GET(PSUNDC(31))=""
SET PSUNDC(31)="No NDC"
+5 QUIT
+6 ;
+7 ;
FORMIND ;Formulary/Non-Formulary Indicator
+1 ;Field # 50,51 [NON-FORMULARY]**Field to be extracted
+2 SET PSUFID(51)=$$VALI^PSUTL(50,PSUDRG(4),"51")
+3 QUIT
+4 ;
NFIND ;National Formulary Indicator
+1 ;Product will need to check whether or not Vs 4.0 of
+2 ;National Drug File is installed. If not, this field will not exist.
+3 ;Check for National Drug File
+4 SET (NFIND,NFRES)=""
+5 SET VERSION=$$VERSION^XPDUTL("PSN")
+6 if VERSION<4.0
QUIT
+7 ;Field # 50.68,17 [NATIONAL FORMULARY INDICATOR]***Field to be extracted
+8 ;If National Drug File vs 4.0 is not installed
+9 ;Transmission format: Send null
+10 ;If National Drug File vs 4.0 is installed
+11 SET PSUDRG4=PSUDRG(4)
+12 DO GETS^PSUTL(50,PSUDRG4,"20;22;3;52","PSUDRG","I")
+13 DO MOVEI^PSUTL("PSUDRG")
+14 SET PSUDRG(4)=PSUDRG4
+15 ;
+16 SET PSUNFI(17)=$$FORMI^PSNAPIS(PSUDRG(20),PSUDRG(22))
+17 ;Transmission format: Internal value ('1' for Yes, '0' for No)
+18 ;National Formulary Restriction Indicator
+19 ;Product shall check whether or not Vs 4.0 of National Drug File
+20 ;is installed. If not, this field will not exist.
+21 ;Field #50.6818,.01[NATIONAL FORMULARY RESTRICTION]Field to be extracted
+22 ;
+23 SET PSUNFR(.01)=$$FORMR^PSNAPIS(PSUDRG(20),PSUDRG(22))>0
+24 SET PSUNFR(.01)=$SELECT($GET(PSUNFR(.01))="":0,1:PSUNFR(.01))
+25 ;
+26 ;If National Drug File vs 4.0 is not installed
+27 ;Transmission format: Send null
+28 ;If National Drug File vs 4.0 is installed
+29 ;Transmission format: If no value is found send '0',
+30 ;if data exists sent '1'
+31 QUIT
+32 ;
VPNAME ;VA Product Name
+1 ;Field # 50,21[VA PRODUCT NAME]**Field to be extracted
+2 SET PSUVPN(21)=$$VALI^PSUTL(50,PSUDRG(4),"21")
+3 ;if no value found, send "Unknown VA Product Name"
SET PSUDRG4=PSUDRG(4)
+4 IF $GET(PSUVPN(21))=""
SET PSUVPN(21)="Unknown VA Product Name"
+5 DO GETS^PSUTL(50,PSUDRG(4),"3;52","PSUDRG","I")
DO MOVEI^PSUTL("PSUDRG")
+6 ;DEA, NFI
SET PSUDRG(4)=PSUDRG4
+7 QUIT
+8 ;
VDC ; VA Drug Class
+1 ;Field # 50,2 [NATIONAL DRUG CLASS] Pointer to File # 50.605
+2 ;used DRUG pointer from previous quantity check.
+3 SET PSUNAC(2)=$$VALI^PSUTL(50,PSUDRG(4),"2")
+4 ;
+5 ;Field # 50.605,.01 [CODE]**Field to be extracted
+6 SET PSUFID(.01)=PSUNAC(2)
+7 QUIT
+8 ;Field # 58.8001,.01 [DRUG] Pointer to File # 50
+9 ;
PDT ;Package details
+1 ;Field # 58.8001,7 [BREAKDOWN UNIT]**Field to be extracted
+2 ;Field # 58.8001,8 [PACKAGE SIZE]**Field to be extracted
+3 SET PSUSITE=0
+4 SET PSUSITE=$$VALI^PSUTL(58.8,PSUIENDA,20)
+5 if 'PSUSITE
SET PSUSITE=$$VALI^PSUTL(58.81,PSUIENDA,2)
+6 DO GETS^PSUTL(58.8001,"PSUSITE,PSUDRG(4)","7;8","PSUPDT","I")
+7 DO MOVEI^PSUTL("PSUPDT")
+8 SET UNIT=$GET(PSUPDT(7),"NA")
+9 QUIT
