Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUCS4

PSUCS4.m

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