- PSUAR2 ;BIR/PDW - ASSEMBLE AR/WS RECORDS FOR TRANSMISSION ;10 JUL 1999
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ; DBIA(s)
- ; Reference to file #50 supported by DBIA 221
- ;
- EN ;EP Build ("RECORDS") from scan of ^XTMP(PSUARSUB,"DIV_DRUG",Drug,Div)=Total
- S PSUDRDA=0,PSULC=0,PSUDIVDA=0
- K ^XTMP(PSUARSUB,"RECORDS")
- K ^XTMP(PSUARSUB,"DRUG_TOTAL")
- F S PSUDIVDA=$O(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIVDA)) Q:PSUDIVDA="" D DRUGSCAN
- Q
- ;
- DRUGSCAN ;EP Scan for Drugs within division
- S PSUDDRDA=0,PSULC=0 ;**1
- F S PSUDRDA=$O(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIVDA,PSUDRDA)) Q:PSUDRDA'>0 S PSUTOT=^(PSUDRDA) D
- . S PSULC=PSULC+1
- . S ^XTMP(PSUARSUB,"RECORDS",PSUDIVDA,PSULC)=$$RECORD(PSUDRDA,PSUDIVDA,PSUTOT)
- . S X=$G(^XTMP(PSUARSUB,"DRUG_TOTAL",PSUDRDA))
- . S ^XTMP(PSUARSUB,"DRUG_TOTAL",PSUDRDA)=X+PSUTOT
- Q
- ;
- RECORD(PSUDRDA,PSUDIV,PSUTOT) ;EP Return record assembled
- ;
- ; @x@(Fld) holds the appropriate field values from the drug file 50
- ;
- N PSU,PSUP,PSUSEND,PSUDIVH
- I '$D(^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDRDA)) D DRUG(PSUDRDA)
- S X="^XTMP(PSUARSUB,""PSUDRUG_DET"",PSUDRDA)"
- ; piece = value @X@(field from file 50)
- ; Process for sender being division or site
- S PSUSEND=PSUDIV,PSUDIVH=""
- I PSUDIV["_0H" S PSUSEND=$G(PSUSNDR),PSUDIVH="H"
- S PSU(2)=PSUSEND
- S PSU(3)=PSUDIVH
- S PSU(4)=$G(PSUMON)
- S PSU(5)=@X@(21)
- S PSU(6)=@X@(2)
- S PSU(7)=@X@(31)
- S PSU(8)=@X@(.01)
- S PSU(9)=@X@(51)
- S PSU(10)=@X@(99999.17) ;indicator for National Formulary
- S PSU(11)=@X@(99999.18) ;Indicator for National Formulary Restriction
- S PSU(12)=@X@(14.5)
- S PSU(13)=@X@(16)
- S PSU(14)=@X@(301)
- S PSU(15)=@X@(302)
- S PSU(16)=$G(PSUTOT)
- S PSU(17)=@X@(52)
- S PSU(18)=@X@(3)
- S PSU(19)=$G(PSUTDSP(PSUDIVDA,PSUDRDA)) ;Quantity Dispensed
- S PSU(20)=$G(PSUTRET(PSUDIVDA,PSUDRDA)) ;Quantity Returned
- S PSUP=0
- F S PSUP=$O(PSU(PSUP)) Q:PSUP'>0 S PSU(PSUP)=$TR(PSU(PSUP),"^","'")
- S PSUP=0
- F S PSUP=$O(PSU(PSUP)) Q:PSUP'>0 S $P(PSU,"^",PSUP)=PSU(PSUP)
- S PSU=PSU_"^"
- Q PSU
- ;
- DRUG(PSUDRDA) ;EP assemble from file 50+ needed fields
- ; PSUDRDA is da for the DRUG in file 50 from (58.52,.01)
- ; Store the fields in ^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDDA,Field)=value
- N PSUDRUG,PSUNDF
- D GETS^PSUTL(50,PSUDRDA,".01;2;14.5;15;16;20;21;22;25;31;51;301;302;52;3","PSUDRUG","I")
- ; Move PSUDRUG(Field,"I") value to PSUDRUG(Field) nodes
- D MOVEI^PSUTL("PSUDRUG")
- ;
- PROCESS ;Further process field values into their final values
- ;
- S PSUDRUG(51)=$$VAL^PSUTL(50,PSUDRDA,51)
- I PSUDRUG(31)="" S PSUDRUG(31)="No NDC"
- I PSUDRUG(21)="" S PSUDRUG(21)="Unknown VA Product Name"
- I PSUDRUG(.01)="" S PSUDRUG(.01)="Unknown Generic Name"
- S X=+PSUDRUG(301)
- S PSUDRUG(301)=$S(X=0:"03 or 04",X=1:"06 or 07",2:"17",3:"22",1:X)
- I PSUDRUG(52) S PSUDRUG(52)="N/F"
- ;
- ; Process VA DRUG CLASS
- ; Test for new NDF software s PSUNDF=1 if yes
- S PSUNDF=0
- I $$VERSION^XPDUTL("PSN")'<4 S PSUNDF=1
- ;
- ; Process for National Formulary Indicator & Restrictions
- ; Put into node 99999.17 for file(50.68,17)
- ; Put into node 99999.18 for file(50.68,18)
- ; test to see if file 50.68 exists (comes in with V4 of NDF)
- S PSUDRUG(99999.17)=""
- S PSUDRUG(99999.18)=""
- I 'PSUNDF G STORE
- ; Process for National Formulary Indicator from VA Product Name file
- S PSUVPNDA=PSUDRUG(22)
- I PSUNDF S PSUDRUG(99999.17)=$$FORMI^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
- ; Process for National Formulary Restriction
- I PSUNDF S PSUDRUG(99999.18)=$$FORMR^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
- K PSUNFR
- ;
- STORE ;Store the processed values into ^TMP
- M ^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDRDA)=PSUDRUG
- Q
- ;
- REC ;EP Move PSUAR_RECORDS to PSUAREC)
- M ^XTMP(PSUARSUB,"PSUAREC")=^XTMP(PSUARSUB,"RECORDS",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUAR2 3782 printed Feb 18, 2025@23:53:25 Page 2
- PSUAR2 ;BIR/PDW - ASSEMBLE AR/WS RECORDS FOR TRANSMISSION ;10 JUL 1999
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ; DBIA(s)
- +3 ; Reference to file #50 supported by DBIA 221
- +4 ;
- EN ;EP Build ("RECORDS") from scan of ^XTMP(PSUARSUB,"DIV_DRUG",Drug,Div)=Total
- +1 SET PSUDRDA=0
- SET PSULC=0
- SET PSUDIVDA=0
- +2 KILL ^XTMP(PSUARSUB,"RECORDS")
- +3 KILL ^XTMP(PSUARSUB,"DRUG_TOTAL")
- +4 FOR
- SET PSUDIVDA=$ORDER(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIVDA))
- if PSUDIVDA=""
- QUIT
- DO DRUGSCAN
- +5 QUIT
- +6 ;
- DRUGSCAN ;EP Scan for Drugs within division
- +1 ;**1
- SET PSUDDRDA=0
- SET PSULC=0
- +2 FOR
- SET PSUDRDA=$ORDER(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIVDA,PSUDRDA))
- if PSUDRDA'>0
- QUIT
- SET PSUTOT=^(PSUDRDA)
- Begin DoDot:1
- +3 SET PSULC=PSULC+1
- +4 SET ^XTMP(PSUARSUB,"RECORDS",PSUDIVDA,PSULC)=$$RECORD(PSUDRDA,PSUDIVDA,PSUTOT)
- +5 SET X=$GET(^XTMP(PSUARSUB,"DRUG_TOTAL",PSUDRDA))
- +6 SET ^XTMP(PSUARSUB,"DRUG_TOTAL",PSUDRDA)=X+PSUTOT
- End DoDot:1
- +7 QUIT
- +8 ;
- RECORD(PSUDRDA,PSUDIV,PSUTOT) ;EP Return record assembled
- +1 ;
- +2 ; @x@(Fld) holds the appropriate field values from the drug file 50
- +3 ;
- +4 NEW PSU,PSUP,PSUSEND,PSUDIVH
- +5 IF '$DATA(^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDRDA))
- DO DRUG(PSUDRDA)
- +6 SET X="^XTMP(PSUARSUB,""PSUDRUG_DET"",PSUDRDA)"
- +7 ; piece = value @X@(field from file 50)
- +8 ; Process for sender being division or site
- +9 SET PSUSEND=PSUDIV
- SET PSUDIVH=""
- +10 IF PSUDIV["_0H"
- SET PSUSEND=$GET(PSUSNDR)
- SET PSUDIVH="H"
- +11 SET PSU(2)=PSUSEND
- +12 SET PSU(3)=PSUDIVH
- +13 SET PSU(4)=$GET(PSUMON)
- +14 SET PSU(5)=@X@(21)
- +15 SET PSU(6)=@X@(2)
- +16 SET PSU(7)=@X@(31)
- +17 SET PSU(8)=@X@(.01)
- +18 SET PSU(9)=@X@(51)
- +19 ;indicator for National Formulary
- SET PSU(10)=@X@(99999.17)
- +20 ;Indicator for National Formulary Restriction
- SET PSU(11)=@X@(99999.18)
- +21 SET PSU(12)=@X@(14.5)
- +22 SET PSU(13)=@X@(16)
- +23 SET PSU(14)=@X@(301)
- +24 SET PSU(15)=@X@(302)
- +25 SET PSU(16)=$GET(PSUTOT)
- +26 SET PSU(17)=@X@(52)
- +27 SET PSU(18)=@X@(3)
- +28 ;Quantity Dispensed
- SET PSU(19)=$GET(PSUTDSP(PSUDIVDA,PSUDRDA))
- +29 ;Quantity Returned
- SET PSU(20)=$GET(PSUTRET(PSUDIVDA,PSUDRDA))
- +30 SET PSUP=0
- +31 FOR
- SET PSUP=$ORDER(PSU(PSUP))
- if PSUP'>0
- QUIT
- SET PSU(PSUP)=$TRANSLATE(PSU(PSUP),"^","'")
- +32 SET PSUP=0
- +33 FOR
- SET PSUP=$ORDER(PSU(PSUP))
- if PSUP'>0
- QUIT
- SET $PIECE(PSU,"^",PSUP)=PSU(PSUP)
- +34 SET PSU=PSU_"^"
- +35 QUIT PSU
- +36 ;
- DRUG(PSUDRDA) ;EP assemble from file 50+ needed fields
- +1 ; PSUDRDA is da for the DRUG in file 50 from (58.52,.01)
- +2 ; Store the fields in ^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDDA,Field)=value
- +3 NEW PSUDRUG,PSUNDF
- +4 DO GETS^PSUTL(50,PSUDRDA,".01;2;14.5;15;16;20;21;22;25;31;51;301;302;52;3","PSUDRUG","I")
- +5 ; Move PSUDRUG(Field,"I") value to PSUDRUG(Field) nodes
- +6 DO MOVEI^PSUTL("PSUDRUG")
- +7 ;
- PROCESS ;Further process field values into their final values
- +1 ;
- +2 SET PSUDRUG(51)=$$VAL^PSUTL(50,PSUDRDA,51)
- +3 IF PSUDRUG(31)=""
- SET PSUDRUG(31)="No NDC"
- +4 IF PSUDRUG(21)=""
- SET PSUDRUG(21)="Unknown VA Product Name"
- +5 IF PSUDRUG(.01)=""
- SET PSUDRUG(.01)="Unknown Generic Name"
- +6 SET X=+PSUDRUG(301)
- +7 SET PSUDRUG(301)=$SELECT(X=0:"03 or 04",X=1:"06 or 07",2:"17",3:"22",1:X)
- +8 IF PSUDRUG(52)
- SET PSUDRUG(52)="N/F"
- +9 ;
- +10 ; Process VA DRUG CLASS
- +11 ; Test for new NDF software s PSUNDF=1 if yes
- +12 SET PSUNDF=0
- +13 IF $$VERSION^XPDUTL("PSN")'<4
- SET PSUNDF=1
- +14 ;
- +15 ; Process for National Formulary Indicator & Restrictions
- +16 ; Put into node 99999.17 for file(50.68,17)
- +17 ; Put into node 99999.18 for file(50.68,18)
- +18 ; test to see if file 50.68 exists (comes in with V4 of NDF)
- +19 SET PSUDRUG(99999.17)=""
- +20 SET PSUDRUG(99999.18)=""
- +21 IF 'PSUNDF
- GOTO STORE
- +22 ; Process for National Formulary Indicator from VA Product Name file
- +23 SET PSUVPNDA=PSUDRUG(22)
- +24 IF PSUNDF
- SET PSUDRUG(99999.17)=$$FORMI^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
- +25 ; Process for National Formulary Restriction
- +26 IF PSUNDF
- SET PSUDRUG(99999.18)=$$FORMR^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
- +27 KILL PSUNFR
- +28 ;
- STORE ;Store the processed values into ^TMP
- +1 MERGE ^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDRDA)=PSUDRUG
- +2 QUIT
- +3 ;
- REC ;EP Move PSUAR_RECORDS to PSUAREC)
- +1 MERGE ^XTMP(PSUARSUB,"PSUAREC")=^XTMP(PSUARSUB,"RECORDS",$JOB)
- +2 QUIT