BPS19PST ;ALB/DMB - Post-install for BPS*1.0*19 ;10/21/2014
;;1.0;E CLAIMS MGMT ENGINE;**19**;JUN 2004;Build 18
;;Per VA Directive 6402, this routine should not be modified.
;
; NCPDP Continuous Maintenance Standards - BPS*1*19 patch post install
;
Q
;
EN ; Entry Point for post-install
D MES^XPDUTL(" Starting post-install for BPS*1*19")
;
; Update the OTHER PAYER AMT PAID QUALIFIER field in the BPS REQUEST file
D REQUEST
;
; Delete the BPS NCPDP FIELD CODE file
D FLDCD
;
; Queue background task to update the OTHER PAYER AMT PAID QUALIFIER field in other files
D JOB
;
EX ; exit point
D BMES^XPDUTL(" Finished post-install of BPS*1*19")
Q
;
REQUEST ;
; Loop through BPS REQUESTS and change the OTHER PAYER AMT PAID QUALIFIER from
; a set of codes to a pointer
N IEN,IEN1,IEN2,OIEN,CODE,CNT,SUCCNT
D BMES^XPDUTL(" Update BPS REQUESTS file")
;
; Loop through the BPS REQUESTS file
S CNT=0,SUCCNT=0
S IEN=0 F S IEN=$O(^BPS(9002313.77,IEN)) Q:'IEN D
. S CNT=CNT+1
. I CNT#1000=1 W "."
. S IEN1=0 F S IEN1=$O(^BPS(9002313.77,IEN,8,IEN1)) Q:'IEN1 D
.. S IEN2=0 F S IEN2=$O(^BPS(9002313.77,IEN,8,IEN1,1,IEN2)) Q:'IEN2 D
... S CODE=$P($G(^BPS(9002313.77,IEN,8,IEN1,1,IEN2,0)),"^",2)
... I CODE="" Q
... I CODE=11 Q ; This is Sales Tax that was already converted
... I CODE=" " S CODE="00" ; Not Specified (dictionary is '00', NCPDP is " ".
... S OIEN=$O(^BPS(9002313.2,"B",CODE,""))
... I OIEN="" Q
... S $P(^BPS(9002313.77,IEN,8,IEN1,1,IEN2,0),"^",2)=OIEN
... S SUCCNT=SUCCNT+1
;
D MES^XPDUTL(" Complete - Updated "_SUCCNT_" records.")
Q
;
FLDCD ;
; Delete the BPS NCPDP FIELD CODE file
;
D BMES^XPDUTL(" Delete the BPS NCPDP FIELD CODE file")
I '$D(^BPS(9002313.94)),'$D(^DIC(9002313.94)) D MES^XPDUTL(" Already Deleted") Q
N DIU
S DIU=9002313.94,DIU(0)="D"
D EN^DIU2
D MES^XPDUTL(" Complete")
Q
;
JOB ;
D BMES^XPDUTL(" Queuing background job to update the OTHER PAYER AMT PAID QUALIFIER field")
D MES^XPDUTL(" A Mailman message will be sent when it finishes")
;
; Setup required variables
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
S ZTRTN="UPDATE^BPS19PST",ZTIO="",ZTDTH=$H
S ZTDESC="Background job to update the OTHER PAYER AMT PAID QUALIFIER field via BPS*1*19"
;
; Task the job
D ^%ZTLOAD
;
; Check if task was created
I $D(ZTSK) D MES^XPDUTL(" Task #"_ZTSK_" queued")
I '$D(ZTSK) D MES^XPDUTL(" Task not queued. Please create a support ticket.")
Q
;
UPDATE ;
; Update the OTHER PAYER AMT PAID QUALIFIER in BPS Transaction, BPS Log of Transactions,
; and BPS Certification.
;
N IEN,IEN1,IEN2,IEN3,OIEN,CODE,TRANCNT,LOGCNT,CERTCNT
;
; Loop through BPS TRANSACTIONs and change the OTHER PAYER AMT PAID QUALIFIER from
; a set of codes to a pointer
S TRANCNT=0
S IEN=0 F S IEN=$O(^BPST(IEN)) Q:'IEN D
. S IEN1=0 F S IEN1=$O(^BPST(IEN,14,IEN1)) Q:'IEN1 D
.. S IEN2=0 F S IEN2=$O(^BPST(IEN,14,IEN1,1,IEN2)) Q:'IEN2 D
... S CODE=$P($G(^BPST(IEN,14,IEN1,1,IEN2,0)),"^",2)
... I CODE="" Q
... I CODE=11 Q ; This is Sales Tax that was already converted
... I CODE=" " S CODE="00" ; Not Specified (dictionary is '00', NCPDP is " ".
... S OIEN=$O(^BPS(9002313.2,"B",CODE,""))
... I OIEN="" Q
... S $P(^BPST(IEN,14,IEN1,1,IEN2,0),"^",2)=OIEN
... S TRANCNT=TRANCNT+1
;
; Loop through BPS LOG OF TRANSACTIONs and change the OTHER PAYER AMT PAID
; QUALIFIER from a set of codes to a pointer
S LOGCNT=0
S IEN=0 F S IEN=$O(^BPSTL(IEN)) Q:'IEN D
. S IEN1=0 F S IEN1=$O(^BPSTL(IEN,14,IEN1)) Q:'IEN1 D
.. S IEN2=0 F S IEN2=$O(^BPSTL(IEN,14,IEN1,1,IEN2)) Q:'IEN2 D
... S CODE=$P($G(^BPSTL(IEN,14,IEN1,1,IEN2,0)),"^",2)
... I CODE="" Q
... I CODE=11 Q ; This is Sales Tax that was already converted
... I CODE=" " S CODE="00" ; Not Specified (dictionary is '00', NCPDP is " ".
... S OIEN=$O(^BPS(9002313.2,"B",CODE,""))
... I OIEN="" Q
... S $P(^BPSTL(IEN,14,IEN1,1,IEN2,0),"^",2)=OIEN
... S LOGCNT=LOGCNT+1
;
; Loop through BPS CERTIFICATION and change the OTHER PAYER AMT PAID QUALIFIER from
; a set of codes to a pointer
S CERTCNT=0
S IEN=0 F S IEN=$O(^BPS(9002313.31,IEN)) Q:'IEN D
. S IEN1=0 F S IEN1=$O(^BPS(9002313.31,IEN,2,IEN1)) Q:'IEN1 D
.. S IEN2=0 F S IEN2=$O(^BPS(9002313.31,IEN,2,IEN1,3,IEN2)) Q:'IEN2 D
... S IEN3=0 F S IEN3=$O(^BPS(9002313.31,IEN,2,IEN1,3,IEN2,1,IEN3)) Q:'IEN3 D
.... S CODE=$P($G(^BPS(9002313.31,IEN,2,IEN1,3,IEN2,1,IEN3,0)),"^",2)
.... I CODE="" Q
.... I CODE=11 Q ; This is Sales Tax that was already converted
.... I CODE=" " S CODE="00" ; Not Specified (dictionary is '00', NCPDP is " ".
.... S OIEN=$O(^BPS(9002313.2,"B",CODE,""))
.... I OIEN="" Q
.... S $P(^BPS(9002313.31,IEN,2,IEN1,3,IEN2,1,IEN3,0),"^",2)=OIEN
.... S CERTCNT=CERTCNT+1
;
; Send mailman message with results
D MAIL(TRANCNT,LOGCNT,CERTCNT)
Q
;
MAIL(TRANCNT,LOGCNT,CERTCNT) ;
N CNT,MSG,XMY,XMDUZ,DIFROM,XMSUB,XMTEXT
S XMY(DUZ)=""
S XMSUB="BPS*1.0*19 Post install is complete",XMDUZ="Patch BPS*1.0*19"
S XMTEXT="MSG("
S CNT=1,MSG(CNT)=""
S CNT=CNT+1,MSG(CNT)="Patch BPS*1.0*19 post install routine has completed."
S CNT=CNT+1,MSG(CNT)=""
S CNT=CNT+1,MSG(CNT)="Updated "_TRANCNT_" records in the BPS TRANSACTION file."
S CNT=CNT+1,MSG(CNT)="Updated "_LOGCNT_" records in the BPS LOG OF TRANSACTIONS file."
S CNT=CNT+1,MSG(CNT)="Updated "_CERTCNT_" records in the BPS CERTIFICATION file."
S CNT=CNT+1,MSG(CNT)=""
S CNT=CNT+1,MSG(CNT)="For more information about this post install, review the patch description."
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS19PST 5667 printed Apr 09, 2024@20:55:35 Page 2
BPS19PST ;ALB/DMB - Post-install for BPS*1.0*19 ;10/21/2014
+1 ;;1.0;E CLAIMS MGMT ENGINE;**19**;JUN 2004;Build 18
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; NCPDP Continuous Maintenance Standards - BPS*1*19 patch post install
+5 ;
+6 QUIT
+7 ;
EN ; Entry Point for post-install
+1 DO MES^XPDUTL(" Starting post-install for BPS*1*19")
+2 ;
+3 ; Update the OTHER PAYER AMT PAID QUALIFIER field in the BPS REQUEST file
+4 DO REQUEST
+5 ;
+6 ; Delete the BPS NCPDP FIELD CODE file
+7 DO FLDCD
+8 ;
+9 ; Queue background task to update the OTHER PAYER AMT PAID QUALIFIER field in other files
+10 DO JOB
+11 ;
EX ; exit point
+1 DO BMES^XPDUTL(" Finished post-install of BPS*1*19")
+2 QUIT
+3 ;
REQUEST ;
+1 ; Loop through BPS REQUESTS and change the OTHER PAYER AMT PAID QUALIFIER from
+2 ; a set of codes to a pointer
+3 NEW IEN,IEN1,IEN2,OIEN,CODE,CNT,SUCCNT
+4 DO BMES^XPDUTL(" Update BPS REQUESTS file")
+5 ;
+6 ; Loop through the BPS REQUESTS file
+7 SET CNT=0
SET SUCCNT=0
+8 SET IEN=0
FOR
SET IEN=$ORDER(^BPS(9002313.77,IEN))
if 'IEN
QUIT
Begin DoDot:1
+9 SET CNT=CNT+1
+10 IF CNT#1000=1
WRITE "."
+11 SET IEN1=0
FOR
SET IEN1=$ORDER(^BPS(9002313.77,IEN,8,IEN1))
if 'IEN1
QUIT
Begin DoDot:2
+12 SET IEN2=0
FOR
SET IEN2=$ORDER(^BPS(9002313.77,IEN,8,IEN1,1,IEN2))
if 'IEN2
QUIT
Begin DoDot:3
+13 SET CODE=$PIECE($GET(^BPS(9002313.77,IEN,8,IEN1,1,IEN2,0)),"^",2)
+14 IF CODE=""
QUIT
+15 ; This is Sales Tax that was already converted
IF CODE=11
QUIT
+16 ; Not Specified (dictionary is '00', NCPDP is " ".
IF CODE=" "
SET CODE="00"
+17 SET OIEN=$ORDER(^BPS(9002313.2,"B",CODE,""))
+18 IF OIEN=""
QUIT
+19 SET $PIECE(^BPS(9002313.77,IEN,8,IEN1,1,IEN2,0),"^",2)=OIEN
+20 SET SUCCNT=SUCCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 DO MES^XPDUTL(" Complete - Updated "_SUCCNT_" records.")
+23 QUIT
+24 ;
FLDCD ;
+1 ; Delete the BPS NCPDP FIELD CODE file
+2 ;
+3 DO BMES^XPDUTL(" Delete the BPS NCPDP FIELD CODE file")
+4 IF '$DATA(^BPS(9002313.94))
IF '$DATA(^DIC(9002313.94))
DO MES^XPDUTL(" Already Deleted")
QUIT
+5 NEW DIU
+6 SET DIU=9002313.94
SET DIU(0)="D"
+7 DO EN^DIU2
+8 DO MES^XPDUTL(" Complete")
+9 QUIT
+10 ;
JOB ;
+1 DO BMES^XPDUTL(" Queuing background job to update the OTHER PAYER AMT PAID QUALIFIER field")
+2 DO MES^XPDUTL(" A Mailman message will be sent when it finishes")
+3 ;
+4 ; Setup required variables
+5 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
+6 SET ZTRTN="UPDATE^BPS19PST"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+7 SET ZTDESC="Background job to update the OTHER PAYER AMT PAID QUALIFIER field via BPS*1*19"
+8 ;
+9 ; Task the job
+10 DO ^%ZTLOAD
+11 ;
+12 ; Check if task was created
+13 IF $DATA(ZTSK)
DO MES^XPDUTL(" Task #"_ZTSK_" queued")
+14 IF '$DATA(ZTSK)
DO MES^XPDUTL(" Task not queued. Please create a support ticket.")
+15 QUIT
+16 ;
UPDATE ;
+1 ; Update the OTHER PAYER AMT PAID QUALIFIER in BPS Transaction, BPS Log of Transactions,
+2 ; and BPS Certification.
+3 ;
+4 NEW IEN,IEN1,IEN2,IEN3,OIEN,CODE,TRANCNT,LOGCNT,CERTCNT
+5 ;
+6 ; Loop through BPS TRANSACTIONs and change the OTHER PAYER AMT PAID QUALIFIER from
+7 ; a set of codes to a pointer
+8 SET TRANCNT=0
+9 SET IEN=0
FOR
SET IEN=$ORDER(^BPST(IEN))
if 'IEN
QUIT
Begin DoDot:1
+10 SET IEN1=0
FOR
SET IEN1=$ORDER(^BPST(IEN,14,IEN1))
if 'IEN1
QUIT
Begin DoDot:2
+11 SET IEN2=0
FOR
SET IEN2=$ORDER(^BPST(IEN,14,IEN1,1,IEN2))
if 'IEN2
QUIT
Begin DoDot:3
+12 SET CODE=$PIECE($GET(^BPST(IEN,14,IEN1,1,IEN2,0)),"^",2)
+13 IF CODE=""
QUIT
+14 ; This is Sales Tax that was already converted
IF CODE=11
QUIT
+15 ; Not Specified (dictionary is '00', NCPDP is " ".
IF CODE=" "
SET CODE="00"
+16 SET OIEN=$ORDER(^BPS(9002313.2,"B",CODE,""))
+17 IF OIEN=""
QUIT
+18 SET $PIECE(^BPST(IEN,14,IEN1,1,IEN2,0),"^",2)=OIEN
+19 SET TRANCNT=TRANCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
+21 ; Loop through BPS LOG OF TRANSACTIONs and change the OTHER PAYER AMT PAID
+22 ; QUALIFIER from a set of codes to a pointer
+23 SET LOGCNT=0
+24 SET IEN=0
FOR
SET IEN=$ORDER(^BPSTL(IEN))
if 'IEN
QUIT
Begin DoDot:1
+25 SET IEN1=0
FOR
SET IEN1=$ORDER(^BPSTL(IEN,14,IEN1))
if 'IEN1
QUIT
Begin DoDot:2
+26 SET IEN2=0
FOR
SET IEN2=$ORDER(^BPSTL(IEN,14,IEN1,1,IEN2))
if 'IEN2
QUIT
Begin DoDot:3
+27 SET CODE=$PIECE($GET(^BPSTL(IEN,14,IEN1,1,IEN2,0)),"^",2)
+28 IF CODE=""
QUIT
+29 ; This is Sales Tax that was already converted
IF CODE=11
QUIT
+30 ; Not Specified (dictionary is '00', NCPDP is " ".
IF CODE=" "
SET CODE="00"
+31 SET OIEN=$ORDER(^BPS(9002313.2,"B",CODE,""))
+32 IF OIEN=""
QUIT
+33 SET $PIECE(^BPSTL(IEN,14,IEN1,1,IEN2,0),"^",2)=OIEN
+34 SET LOGCNT=LOGCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;
+36 ; Loop through BPS CERTIFICATION and change the OTHER PAYER AMT PAID QUALIFIER from
+37 ; a set of codes to a pointer
+38 SET CERTCNT=0
+39 SET IEN=0
FOR
SET IEN=$ORDER(^BPS(9002313.31,IEN))
if 'IEN
QUIT
Begin DoDot:1
+40 SET IEN1=0
FOR
SET IEN1=$ORDER(^BPS(9002313.31,IEN,2,IEN1))
if 'IEN1
QUIT
Begin DoDot:2
+41 SET IEN2=0
FOR
SET IEN2=$ORDER(^BPS(9002313.31,IEN,2,IEN1,3,IEN2))
if 'IEN2
QUIT
Begin DoDot:3
+42 SET IEN3=0
FOR
SET IEN3=$ORDER(^BPS(9002313.31,IEN,2,IEN1,3,IEN2,1,IEN3))
if 'IEN3
QUIT
Begin DoDot:4
+43 SET CODE=$PIECE($GET(^BPS(9002313.31,IEN,2,IEN1,3,IEN2,1,IEN3,0)),"^",2)
+44 IF CODE=""
QUIT
+45 ; This is Sales Tax that was already converted
IF CODE=11
QUIT
+46 ; Not Specified (dictionary is '00', NCPDP is " ".
IF CODE=" "
SET CODE="00"
+47 SET OIEN=$ORDER(^BPS(9002313.2,"B",CODE,""))
+48 IF OIEN=""
QUIT
+49 SET $PIECE(^BPS(9002313.31,IEN,2,IEN1,3,IEN2,1,IEN3,0),"^",2)=OIEN
+50 SET CERTCNT=CERTCNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 ;
+52 ; Send mailman message with results
+53 DO MAIL(TRANCNT,LOGCNT,CERTCNT)
+54 QUIT
+55 ;
MAIL(TRANCNT,LOGCNT,CERTCNT) ;
+1 NEW CNT,MSG,XMY,XMDUZ,DIFROM,XMSUB,XMTEXT
+2 SET XMY(DUZ)=""
+3 SET XMSUB="BPS*1.0*19 Post install is complete"
SET XMDUZ="Patch BPS*1.0*19"
+4 SET XMTEXT="MSG("
+5 SET CNT=1
SET MSG(CNT)=""
+6 SET CNT=CNT+1
SET MSG(CNT)="Patch BPS*1.0*19 post install routine has completed."
+7 SET CNT=CNT+1
SET MSG(CNT)=""
+8 SET CNT=CNT+1
SET MSG(CNT)="Updated "_TRANCNT_" records in the BPS TRANSACTION file."
+9 SET CNT=CNT+1
SET MSG(CNT)="Updated "_LOGCNT_" records in the BPS LOG OF TRANSACTIONS file."
+10 SET CNT=CNT+1
SET MSG(CNT)="Updated "_CERTCNT_" records in the BPS CERTIFICATION file."
+11 SET CNT=CNT+1
SET MSG(CNT)=""
+12 SET CNT=CNT+1
SET MSG(CNT)="For more information about this post install, review the patch description."
+13 DO ^XMD
+14 QUIT
