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

PSUCS2.m

Go to the documentation of this file.
  1. PSUCS2 ;BIR/DJE,DJM - Generate CS records (TYPE2) ;25 AUG 1998
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. ;DBIA's
  1. ; Reference to File #58.81 supported by DBIA 2520
  1. ; Reference to File #50 supported by DBIA 221
  1. ; Reference to File #58.8 supported by DBIA 2519
  1. ; Reference to File #59 supported by DBIA 2510
  1. ;
  1. ; *
  1. ; TYPE 2 - "Dispensed from pharmacy"
  1. ; *
  1. ;
  1. TYP2 ; Processing the transaction for dispensing type 2
  1. ;('logged for patient'). If the pharmacy location for transactions
  1. ;with a dispensing type = 2 is associated with either an Outpatient
  1. ; Or Inpatient site, it may be possible to break down the sender by
  1. ;the outpatient clinic or inpatient division.
  1. ;
  1. K PSUQUIT
  1. S PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,4)
  1. ;
  1. ;(type 2 specific call)
  1. D QTY2
  1. I 'PSUTQY(5) S PSUQUIT=1 Q ; do not send if QTY=0
  1. ;
  1. ; Unit cost
  1. S PSUPDU(16)=$$VALI^PSUTL(50,PSUDRG(4),16)
  1. ;
  1. ; DIVISION
  1. D DIVISION
  1. ;
  1. ;(Type 2 specific call)
  1. D NAOU
  1. ;
  1. ;
  1. ; Generic name, Location type.
  1. D GNAME^PSUCS4,LOCTYP^PSUCS4
  1. ;Requirement 3.2.5.7
  1. I "SM"'[PSULTP(1) S PSUQUIT=1 Q ;**9
  1. ;W PSULTP(1)
  1. ;Requirement 3.2.5.8
  1. I CPFLG="N" S PSUQUIT=1 Q ;**9
  1. ;
  1. ;VA Drug class, Formulary/Non-formulary, National formulary Indicator
  1. D NDC^PSUCS4,FORMIND^PSUCS4,NFIND^PSUCS4
  1. ;
  1. ;
  1. ; VA Product name, VA drug class, Package details.
  1. D VPNAME^PSUCS4,VDC^PSUCS4,PDT^PSUCS4
  1. ;
  1. Q
  1. ;
  1. ;
  1. ;
  1. ;
  1. ;
  1. DIVISION ;
  1. ;Field # 58.81,2 [PHARMACY LOCATION] Points to File # 58.8
  1. S PSUPL(2)=$$VALI^PSUTL(58.81,PSUIENDA,"2")
  1. S SENDER=""
  1. N MAPLOCI
  1. D GETM^PSUTL(59.7,1,"90.02*^.01;.02;.03","MAPLOCI","I")
  1. D MOVEMI^PSUTL("MAPLOCI")
  1. ;
  1. I $G(MAPLOCI(PSUPL(2),.01)) D
  1. .S X=$G(MAPLOCI(PSUPL(2),.02)) I X S SENDER=$$VALI^PSUTL(40.8,X,1)
  1. .S X=$G(MAPLOCI(PSUPL(2),.03)) I X S SENDER=$$VALI^PSUTL(59,X,.06)
  1. I '$G(MAPLOCI(PSUPL(2),.01)) D
  1. .S SENDER=PSUSNDR,PSURI="H"
  1. Q
  1. ;
  1. NAOU ;3.2.5.6. Functional Requirement 6
  1. ;The product shall extract the NAOU if the dispensing type =2.
  1. ;Field # 58.81,17 [NAOU] Points to File # 58.8
  1. S PSUNAOU(17)=$$VALI^PSUTL(58.81,PSUIENDA,"17")
  1. S PSUNAOU=PSUNAOU(17)
  1. ;
  1. ;If the NAOU does not exist for that transaction,
  1. ;extract the Pharmacy PSULOCation.
  1. ;Field # 58.81,2 [PHARMACY PSULOCATION] Points to File # 58.8
  1. I PSUNAOU="" D
  1. .S PSUNAOU(2)=$$VALI^PSUTL(58.81,PSUIENDA,"2")
  1. .S PSUNAOU=PSUNAOU(2)
  1. ;
  1. ;Field # 58.8,.01 [PHARMACY PSULOCATION]***Field to be extracted
  1. S PSUPLC(.01)=$$VALI^PSUTL(58.8,PSUNAOU,".01")
  1. Q
  1. ;
  1. QTY2 ;3.2.5.10. Functional Requirement 10
  1. ;The product shall extract the total quantity dispensed.
  1. ;For transactions with a dispensing type=2, check to see if
  1. ;the quantity was edited (Field # 58.81,48).
  1. ;If so, use the edited (new quantity).
  1. ; if there is a date present then use the NEW QUANTITY value.
  1. ;Field # 58.81,50 [NEW QUANTITY]**Field to be extracted
  1. S PSUQED(48)=$$VALI^PSUTL(58.81,PSUIENDA,"48")
  1. S PSUTQY(5)=$$VALI^PSUTL(58.81,PSUIENDA,5)
  1. S:'PSUDRG(4) PSUDRG(4)=$$VALI^PSUTL(58.81,PSUIENDA,4)
  1. ;
  1. I PSUQED(48) S PSUTQY(5)=$$VALI^PSUTL(58.81,PSUIENDA,50)
  1. S:PSUTQY(5) ^XTMP(PSUCSJB,"TQTY",PSULOC,PSUIENDA,PSUDRG(4))=PSUTQY(5)
  1. Q
  1. ;