BPS36PRE.m

BPS36PRE ;AITC/PED - Pre-install routine for BPS*1*36 ;06/2023

 ;;1.0;E CLAIMS MGMT ENGINE;**36**;JUN 2004;Build 16

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 ; MCCF EDI TAS ePharmacy - BPS*1*36 patch pre-install

 ;

 Q

 ;

PRE ; Entry Point for pre-install

 ;

 D MES^XPDUTL(" Starting pre-install for BPS*1*36")

 ;

 D BPS21

 D BPS23

 ;

 D MES^XPDUTL(" Finished pre-install of BPS*1*36")

 ;

 Q

 ;

BPS21 ; Update File 9002313.21

 ;

 N BPSA,BPSCD,BPSFN,BPSID,BPSREC

 ;

 ; Update Description

 S BPSID=$O(^BPS(9002313.21,"B","MB",""))

 I BPSID="" Q

 S BPSFN=9002313.21

 S BPSREC=BPSID_","

 S BPSA(BPSFN,BPSREC,1)="MEDICATION BENEFIT OUTWEIGHS RISK"

 D FILE^DIE("","BPSA","")

 ;

 ; Inactivate Codes

 F BPSCD="FE","PH","TC" D

 . S BPSID=$O(^BPS(9002313.21,"B",BPSCD,""))

 . I BPSID="" Q

 . S BPSFN=9002313.21

 . S BPSREC=BPSID_","

 . S BPSA(BPSFN,BPSREC,2)=1

 . D FILE^DIE("","BPSA","")

 ;

 Q

 ;

BPS23 ; Update File 9002313.23

 ;

 N BPSA,BPSCD,BPSFN,BPSID,BPSREC

 ;

 ; Update Description

 S BPSID=$O(^BPS(9002313.23,"B","TD",""))

 I BPSID="" Q

 S BPSFN=9002313.23

 S BPSREC=BPSID_","

 S BPSA(BPSFN,BPSREC,1)="THERAPEUTIC DUPLICATION"

 D FILE^DIE("","BPSA","")

 ;

 ; Inactivate Codes

 F BPSCD="CH","LK","SD" D

 . S BPSID=$O(^BPS(9002313.23,"B",BPSCD,""))

 . I BPSID="" Q

 . S BPSFN=9002313.23

 . S BPSREC=BPSID_","

 . S BPSA(BPSFN,BPSREC,2)=1

 . D FILE^DIE("","BPSA","")

 ;

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPS36PRE   1460     printed  Mar 13, 2025@20:55:20                                                                                                                                                                                                    Page 2

BPS36PRE  ;AITC/PED - Pre-install routine for BPS*1*36 ;06/2023

 +1       ;;1.0;E CLAIMS MGMT ENGINE;**36**;JUN 2004;Build 16

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; MCCF EDI TAS ePharmacy - BPS*1*36 patch pre-install

 +5       ;

 +6        QUIT 

 +7       ;

PRE       ; Entry Point for pre-install

 +1       ;

 +2        DO MES^XPDUTL(" Starting pre-install for BPS*1*36")

 +3       ;

 +4        DO BPS21

 +5        DO BPS23

 +6       ;

 +7        DO MES^XPDUTL(" Finished pre-install of BPS*1*36")

 +8       ;

 +9        QUIT 

 +10      ;

BPS21     ; Update File 9002313.21

 +1       ;

 +2        NEW BPSA,BPSCD,BPSFN,BPSID,BPSREC

 +3       ;

 +4       ; Update Description

 +5        SET BPSID=$ORDER(^BPS(9002313.21,"B","MB",""))

 +6        IF BPSID=""

               QUIT 

 +7        SET BPSFN=9002313.21

 +8        SET BPSREC=BPSID_","

 +9        SET BPSA(BPSFN,BPSREC,1)="MEDICATION BENEFIT OUTWEIGHS RISK"

 +10       DO FILE^DIE("","BPSA","")

 +11      ;

 +12      ; Inactivate Codes

 +13       FOR BPSCD="FE","PH","TC"

               Begin DoDot:1

 +14               SET BPSID=$ORDER(^BPS(9002313.21,"B",BPSCD,""))

 +15               IF BPSID=""

                       QUIT 

 +16               SET BPSFN=9002313.21

 +17               SET BPSREC=BPSID_","

 +18               SET BPSA(BPSFN,BPSREC,2)=1

 +19               DO FILE^DIE("","BPSA","")

               End DoDot:1

 +20      ;

 +21       QUIT 

 +22      ;

BPS23     ; Update File 9002313.23

 +1       ;

 +2        NEW BPSA,BPSCD,BPSFN,BPSID,BPSREC

 +3       ;

 +4       ; Update Description

 +5        SET BPSID=$ORDER(^BPS(9002313.23,"B","TD",""))

 +6        IF BPSID=""

               QUIT 

 +7        SET BPSFN=9002313.23

 +8        SET BPSREC=BPSID_","

 +9        SET BPSA(BPSFN,BPSREC,1)="THERAPEUTIC DUPLICATION"

 +10       DO FILE^DIE("","BPSA","")

 +11      ;

 +12      ; Inactivate Codes

 +13       FOR BPSCD="CH","LK","SD"

               Begin DoDot:1

 +14               SET BPSID=$ORDER(^BPS(9002313.23,"B",BPSCD,""))

 +15               IF BPSID=""

                       QUIT 

 +16               SET BPSFN=9002313.23

 +17               SET BPSREC=BPSID_","

 +18               SET BPSA(BPSFN,BPSREC,2)=1

 +19               DO FILE^DIE("","BPSA","")

               End DoDot:1

 +20      ;

 +21       QUIT 

 +22      ;