BPS10P8 ;ALB/SS - BPS*1*8 POST INSTALL ROUTINE ;6/9/08 11:02
;;1.0;E CLAIMS MGMT ENGINE;**8**;JUN 2004;Build 29
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
POST ; post install for BPS*1*8
;
N BPRECIEN,BPFLDEF,BPX,BPSCNT,BPSOK,BPNCPDFL,GETCODE,FORMATCD,SETCODE,MC,ERRMSG,FKI,FKV
D MES^XPDUTL(" Starting post-install of BPS*1*8")
D MES^XPDUTL(" ")
S BPSCNT=0
F BPX=1:1 S BPFLDEF=$P($T(FIELDS+BPX),";;",2,99) Q:BPFLDEF="" D
. S BPNCPDFL=$P(BPFLDEF,";",1) ; ncpdp field#
. S BPRECIEN=+$O(^BPSF(9002313.91,"B",BPNCPDFL,0)) ; ien to file# 9002313.91
. I BPRECIEN=0 D MES^XPDUTL(" error: can't find entry for the NCPDP field # "_BPNCPDFL_" in the file #9002313.91") Q
. ;
. D MES^XPDUTL(" updating data for the NCPDP field# "_BPNCPDFL_"...")
. S BPSOK=0
. ;
. S GETCODE=$P(BPFLDEF,";",2)
. I GETCODE="" S GETCODE=";GET code for this COB field is executed in COB^BPSOSHF"
. K MC,ERRMSG S MC(1,0)=GETCODE
. D WP^DIE(9002313.91,BPRECIEN_",",10,"","MC","ERRMSG")
. I $D(ERRMSG) D Q
.. D MES^XPDUTL("FileMan reported a problem with the GET CODE for field# "_BPNCPDFL_":")
.. S (FKI,FKV)="ERRMSG"
.. F S FKI=$Q(@FKI) Q:FKI'[FKV D MES^XPDUTL(" "_FKI_" = "_$G(@FKI))
.. D MES^XPDUTL(" ")
.. Q
. S BPSOK=BPSOK+1
. ;
. S FORMATCD=$P(BPFLDEF,";",3) ; FORMAT code
. I FORMATCD]"" D
.. K MC,ERRMSG S MC(1,0)=FORMATCD
.. D WP^DIE(9002313.91,BPRECIEN_",",40,"","MC","ERRMSG")
.. I $D(ERRMSG) D Q
... D MES^XPDUTL("FileMan reported a problem with the FORMAT CODE for field# "_BPNCPDFL_":")
... S (FKI,FKV)="ERRMSG"
... F S FKI=$Q(@FKI) Q:FKI'[FKV D MES^XPDUTL(" "_FKI_" = "_$G(@FKI))
... D MES^XPDUTL(" ")
... Q
. S BPSOK=BPSOK+1
. ;
. S SETCODE=$P(BPFLDEF,";",4) ; SET code
. I SETCODE]"" D
.. K MC,ERRMSG S MC(1,0)=SETCODE
.. D WP^DIE(9002313.91,BPRECIEN_",",30,"","MC","ERRMSG")
.. I $D(ERRMSG) D Q
... D MES^XPDUTL("FileMan reported a problem with the SET CODE for field# "_BPNCPDFL_":")
... S (FKI,FKV)="ERRMSG"
... F S FKI=$Q(@FKI) Q:FKI'[FKV D MES^XPDUTL(" "_FKI_" = "_$G(@FKI))
... D MES^XPDUTL(" ")
... Q
. S BPSOK=BPSOK+1
. ;
. I BPSOK=3 S BPSCNT=BPSCNT+1
. Q
;
D MES^XPDUTL(" ")
D MES^XPDUTL(" "_BPSCNT_" entries have been updated successfully.")
D MES^XPDUTL(" ")
D MES^XPDUTL(" ")
;
Q
;
;
FIELDS ; NCPDP field;GET code;FORMAT code;SET code
;;337;;S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1);D SET337^BPSFLD01
;;338;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2);D SET338^BPSFLD01
;;339;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2);D SET339^BPSFLD01
;;340;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10);D SET340^BPSFLD01
;;341;;S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1);D SET341^BPSFLD01
;;342;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2);D SET342^BPSFLD01
;;431;;S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8);D SET431^BPSFLD01
;;443;;S BPS("X")=$$DTF1^BPSECFM($G(BPS("X")));D SET443^BPSFLD01
;;471;;S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2);D SET471^BPSFLD01
;;472;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3);D SET472^BPSFLD01
;;412;S BPS("X")=0;;
;;477;S BPS("X")=0;S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8);
;;481;S BPS("X")=0;;
;;483;S BPS("X")=+BPS("Insurer","Percent Sales Tax Rate Sub");;
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS10P8 3296 printed Apr 09, 2024@20:56:33 Page 2
BPS10P8 ;ALB/SS - BPS*1*8 POST INSTALL ROUTINE ;6/9/08 11:02
+1 ;;1.0;E CLAIMS MGMT ENGINE;**8**;JUN 2004;Build 29
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
POST ; post install for BPS*1*8
+1 ;
+2 NEW BPRECIEN,BPFLDEF,BPX,BPSCNT,BPSOK,BPNCPDFL,GETCODE,FORMATCD,SETCODE,MC,ERRMSG,FKI,FKV
+3 DO MES^XPDUTL(" Starting post-install of BPS*1*8")
+4 DO MES^XPDUTL(" ")
+5 SET BPSCNT=0
+6 FOR BPX=1:1
SET BPFLDEF=$PIECE($TEXT(FIELDS+BPX),";;",2,99)
if BPFLDEF=""
QUIT
Begin DoDot:1
+7 ; ncpdp field#
SET BPNCPDFL=$PIECE(BPFLDEF,";",1)
+8 ; ien to file# 9002313.91
SET BPRECIEN=+$ORDER(^BPSF(9002313.91,"B",BPNCPDFL,0))
+9 IF BPRECIEN=0
DO MES^XPDUTL(" error: can't find entry for the NCPDP field # "_BPNCPDFL_" in the file #9002313.91")
QUIT
+10 ;
+11 DO MES^XPDUTL(" updating data for the NCPDP field# "_BPNCPDFL_"...")
+12 SET BPSOK=0
+13 ;
+14 SET GETCODE=$PIECE(BPFLDEF,";",2)
+15 IF GETCODE=""
SET GETCODE=";GET code for this COB field is executed in COB^BPSOSHF"
+16 KILL MC,ERRMSG
SET MC(1,0)=GETCODE
+17 DO WP^DIE(9002313.91,BPRECIEN_",",10,"","MC","ERRMSG")
+18 IF $DATA(ERRMSG)
Begin DoDot:2
+19 DO MES^XPDUTL("FileMan reported a problem with the GET CODE for field# "_BPNCPDFL_":")
+20 SET (FKI,FKV)="ERRMSG"
+21 FOR
SET FKI=$QUERY(@FKI)
if FKI'[FKV
QUIT
DO MES^XPDUTL(" "_FKI_" = "_$GET(@FKI))
+22 DO MES^XPDUTL(" ")
+23 QUIT
End DoDot:2
QUIT
+24 SET BPSOK=BPSOK+1
+25 ;
+26 ; FORMAT code
SET FORMATCD=$PIECE(BPFLDEF,";",3)
+27 IF FORMATCD]""
Begin DoDot:2
+28 KILL MC,ERRMSG
SET MC(1,0)=FORMATCD
+29 DO WP^DIE(9002313.91,BPRECIEN_",",40,"","MC","ERRMSG")
+30 IF $DATA(ERRMSG)
Begin DoDot:3
+31 DO MES^XPDUTL("FileMan reported a problem with the FORMAT CODE for field# "_BPNCPDFL_":")
+32 SET (FKI,FKV)="ERRMSG"
+33 FOR
SET FKI=$QUERY(@FKI)
if FKI'[FKV
QUIT
DO MES^XPDUTL(" "_FKI_" = "_$GET(@FKI))
+34 DO MES^XPDUTL(" ")
+35 QUIT
End DoDot:3
QUIT
End DoDot:2
+36 SET BPSOK=BPSOK+1
+37 ;
+38 ; SET code
SET SETCODE=$PIECE(BPFLDEF,";",4)
+39 IF SETCODE]""
Begin DoDot:2
+40 KILL MC,ERRMSG
SET MC(1,0)=SETCODE
+41 DO WP^DIE(9002313.91,BPRECIEN_",",30,"","MC","ERRMSG")
+42 IF $DATA(ERRMSG)
Begin DoDot:3
+43 DO MES^XPDUTL("FileMan reported a problem with the SET CODE for field# "_BPNCPDFL_":")
+44 SET (FKI,FKV)="ERRMSG"
+45 FOR
SET FKI=$QUERY(@FKI)
if FKI'[FKV
QUIT
DO MES^XPDUTL(" "_FKI_" = "_$GET(@FKI))
+46 DO MES^XPDUTL(" ")
+47 QUIT
End DoDot:3
QUIT
End DoDot:2
+48 SET BPSOK=BPSOK+1
+49 ;
+50 IF BPSOK=3
SET BPSCNT=BPSCNT+1
+51 QUIT
End DoDot:1
+52 ;
+53 DO MES^XPDUTL(" ")
+54 DO MES^XPDUTL(" "_BPSCNT_" entries have been updated successfully.")
+55 DO MES^XPDUTL(" ")
+56 DO MES^XPDUTL(" ")
+57 ;
+58 QUIT
+59 ;
+60 ;
FIELDS ; NCPDP field;GET code;FORMAT code;SET code
+1 ;;337;;S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1);D SET337^BPSFLD01
+2 ;;338;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2);D SET338^BPSFLD01
+3 ;;339;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2);D SET339^BPSFLD01
+4 ;;340;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10);D SET340^BPSFLD01
+5 ;;341;;S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1);D SET341^BPSFLD01
+6 ;;342;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2);D SET342^BPSFLD01
+7 ;;431;;S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8);D SET431^BPSFLD01
+8 ;;443;;S BPS("X")=$$DTF1^BPSECFM($G(BPS("X")));D SET443^BPSFLD01
+9 ;;471;;S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2);D SET471^BPSFLD01
+10 ;;472;;S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3);D SET472^BPSFLD01
+11 ;;412;S BPS("X")=0;;
+12 ;;477;S BPS("X")=0;S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8);
+13 ;;481;S BPS("X")=0;;
+14 ;;483;S BPS("X")=+BPS("Insurer","Percent Sales Tax Rate Sub");;
+15 ;
+16 ;
