IBY368PO ;YMG/BP - Post-Installation for IB patch 368 ;12-Mar-2007
;;2.0;INTEGRATED BILLING;**368**;12-MAR-2007;Build 21
;
EN ;
N XPDIDTOT S XPDIDTOT=3
D NTFY ; 1. notify FSC that patch has been installed in production
D TEXT ; 2. add new text entries to file 361.3
D AUTOFILE ; 3. clean up stale informational messages in file 361
;
EX ;
Q
;
NTFY ; notify FSC that patch has been installed succesfully
N HEADER,BODY,MAILTO,SITE,TS
D BMES^XPDUTL(" STEP 1 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Sending notification to FSC ...")
; do not send notification if installed in test account
I '$$PROD^XUPROD D MES^XPDUTL("N/A for test account installation."),UPDATE^XPDID(1) Q
D DTNOLF^DICRW
S SITE=$$SITE^VASITE()
S HEADER="Patch IB*2.0*368 installed at VistA site "_$P(SITE,U,2)
D NOW^%DTC S TS=$$HLDATE^HLFNC(%,"TS")
S BODY(.1)="Patch installed successfully at "_$E(TS,5,6)_"/"_$E(TS,7,8)_"/"_$E(TS,1,4)_" "_$E(TS,9,10)_":"_$E(TS,11,12)_":"_$E(TS,13,19)
S BODY(.2)="Station Number: "_$P(SITE,U,3)
; FSC destination address
; FSC address for integration testing
S MAILTO="fsc.edi-team@domain.ext"
D MAIL(HEADER,.BODY,MAILTO)
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(1)
Q
TEXT ; Add new text entries in file 361.3 - IB MESSAGE SCREEN TEXT
N DATA,TXT,DO,DA,DIC,X,Y
D BMES^XPDUTL(" STEP 2 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Adding new entries into file 361.3 ....")
S DATA("ACCEPT")=0
S DATA("ACK/RECEIPT")=0
S DATA("CLAIM ACKNOWLEDGED AND FORWARD")=0
S DATA("FINAL/PAYMENT")=0
S DATA("PAPER CLAIM MAILED VIA USPS")=0
S DATA("ACCEPT *WARNING*")=1
S TXT="" F S TXT=$O(DATA(TXT)) Q:TXT="" D
.I $D(^IBE(361.3,"B",TXT)) Q ; already on file
.S DIC="^IBE(361.3,",DIC(0)="F",X=TXT
.S DIC("DR")=".02////"_DATA(TXT)
.D FILE^DICN
.Q
TX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(2)
Q
;
AUTOFILE ; Check if informational status messages with no Final Review Action qualify for auto-file with no review.
;
N IBDA,IBCNT,IB,Z,STOP,IBAUTO,TXT,NOREVU,IBREV
D BMES^XPDUTL(" STEP 3 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Now looking at all informational status messages on file to see if any of them")
D MES^XPDUTL("can be auto-filed with no review needed. Each ""."" represents 1000 messages.")
D MES^XPDUTL("")
S IBDA=0,IBCNT=0 F S IBDA=$O(^IBM(361,"ASV","I",IBDA)) Q:'IBDA D
.S IBCNT=IBCNT+1 W:(IBCNT#1000=0)&'$D(ZTQUEUED) "."
.S IB=$G(^IBM(361,IBDA,0))
.I $P(IB,U,10)'="" Q ; final review action exists so quit out
.; if this message was previously auto-filed with no review, then
.; update the final review information and quit out
.I $P(IB,U,9)=2,$P(IB,U,14)=1 D Q
..N DIE,DR,DA
..S DIE=361,DR=".1////F",DA=IBDA D ^DIE
..Q
.;
.; IBAUTO - flag indicating that the whole message can be auto-filed
.; with no review needed
.; NOREVU - flag indicating that one of the message lines had 'No
.; Review Needed' text
.; IBREV - flag indicating that one of the message lines had 'Review
.; Always Needed' text (so the whole message needs review)
.;
.S (Z,STOP,IBAUTO)=0 F S Z=$O(^IBM(361,IBDA,1,Z)) Q:'Z D Q:STOP
..S TXT=$G(^IBM(361,IBDA,1,Z,0)) Q:TXT="" ; text line Z
..S NOREVU=$$CKREVU^IBCEM4(TXT,,,.IBREV)
..I IBREV S STOP=1,IBAUTO=0 Q ; 'review always needed' text found
..I NOREVU S IBAUTO=1 ; 'no review needed' text found
..Q
.I IBAUTO D
..N DIE,DR,DA
..S DIE=361,DR=".09////2;.14////1;.1////F",DA=IBDA D ^DIE
..Q
.Q
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(3)
D CLEAN^DILF
Q
;
MAIL(MTITLE,MLINES,MRECIP) ; send message
N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG
S XMSUB=MTITLE,XMDUZ=.5,XMTEXT="MLINES(",XMY(""_MRECIP_"")=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY368PO 3806 printed Apr 09, 2024@21:25:53 Page 2
IBY368PO ;YMG/BP - Post-Installation for IB patch 368 ;12-Mar-2007
+1 ;;2.0;INTEGRATED BILLING;**368**;12-MAR-2007;Build 21
+2 ;
EN ;
+1 NEW XPDIDTOT
SET XPDIDTOT=3
+2 ; 1. notify FSC that patch has been installed in production
DO NTFY
+3 ; 2. add new text entries to file 361.3
DO TEXT
+4 ; 3. clean up stale informational messages in file 361
DO AUTOFILE
+5 ;
EX ;
+1 QUIT
+2 ;
NTFY ; notify FSC that patch has been installed succesfully
+1 NEW HEADER,BODY,MAILTO,SITE,TS
+2 DO BMES^XPDUTL(" STEP 1 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Sending notification to FSC ...")
+5 ; do not send notification if installed in test account
+6 IF '$$PROD^XUPROD
DO MES^XPDUTL("N/A for test account installation.")
DO UPDATE^XPDID(1)
QUIT
+7 DO DTNOLF^DICRW
+8 SET SITE=$$SITE^VASITE()
+9 SET HEADER="Patch IB*2.0*368 installed at VistA site "_$PIECE(SITE,U,2)
+10 DO NOW^%DTC
SET TS=$$HLDATE^HLFNC(%,"TS")
+11 SET BODY(.1)="Patch installed successfully at "_$EXTRACT(TS,5,6)_"/"_$EXTRACT(TS,7,8)_"/"_$EXTRACT(TS,1,4)_" "_$EXTRACT(TS,9,10)_":"_$EXTRACT(TS,11,12)_":"_$EXTRACT(TS,13,19)
+12 SET BODY(.2)="Station Number: "_$PIECE(SITE,U,3)
+13 ; FSC destination address
+14 ; FSC address for integration testing
+15 SET MAILTO="fsc.edi-team@domain.ext"
+16 DO MAIL(HEADER,.BODY,MAILTO)
+17 DO MES^XPDUTL(" Done.")
+18 DO UPDATE^XPDID(1)
+19 QUIT
TEXT ; Add new text entries in file 361.3 - IB MESSAGE SCREEN TEXT
+1 NEW DATA,TXT,DO,DA,DIC,X,Y
+2 DO BMES^XPDUTL(" STEP 2 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Adding new entries into file 361.3 ....")
+5 SET DATA("ACCEPT")=0
+6 SET DATA("ACK/RECEIPT")=0
+7 SET DATA("CLAIM ACKNOWLEDGED AND FORWARD")=0
+8 SET DATA("FINAL/PAYMENT")=0
+9 SET DATA("PAPER CLAIM MAILED VIA USPS")=0
+10 SET DATA("ACCEPT *WARNING*")=1
+11 SET TXT=""
FOR
SET TXT=$ORDER(DATA(TXT))
if TXT=""
QUIT
Begin DoDot:1
+12 ; already on file
IF $DATA(^IBE(361.3,"B",TXT))
QUIT
+13 SET DIC="^IBE(361.3,"
SET DIC(0)="F"
SET X=TXT
+14 SET DIC("DR")=".02////"_DATA(TXT)
+15 DO FILE^DICN
+16 QUIT
End DoDot:1
TX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(2)
+3 QUIT
+4 ;
AUTOFILE ; Check if informational status messages with no Final Review Action qualify for auto-file with no review.
+1 ;
+2 NEW IBDA,IBCNT,IB,Z,STOP,IBAUTO,TXT,NOREVU,IBREV
+3 DO BMES^XPDUTL(" STEP 3 of "_XPDIDTOT)
+4 DO MES^XPDUTL("-------------")
+5 DO MES^XPDUTL("Now looking at all informational status messages on file to see if any of them")
+6 DO MES^XPDUTL("can be auto-filed with no review needed. Each ""."" represents 1000 messages.")
+7 DO MES^XPDUTL("")
+8 SET IBDA=0
SET IBCNT=0
FOR
SET IBDA=$ORDER(^IBM(361,"ASV","I",IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+9 SET IBCNT=IBCNT+1
if (IBCNT#1000=0)&'$DATA(ZTQUEUED)
WRITE "."
+10 SET IB=$GET(^IBM(361,IBDA,0))
+11 ; final review action exists so quit out
IF $PIECE(IB,U,10)'=""
QUIT
+12 ; if this message was previously auto-filed with no review, then
+13 ; update the final review information and quit out
+14 IF $PIECE(IB,U,9)=2
IF $PIECE(IB,U,14)=1
Begin DoDot:2
+15 NEW DIE,DR,DA
+16 SET DIE=361
SET DR=".1////F"
SET DA=IBDA
DO ^DIE
+17 QUIT
End DoDot:2
QUIT
+18 ;
+19 ; IBAUTO - flag indicating that the whole message can be auto-filed
+20 ; with no review needed
+21 ; NOREVU - flag indicating that one of the message lines had 'No
+22 ; Review Needed' text
+23 ; IBREV - flag indicating that one of the message lines had 'Review
+24 ; Always Needed' text (so the whole message needs review)
+25 ;
+26 SET (Z,STOP,IBAUTO)=0
FOR
SET Z=$ORDER(^IBM(361,IBDA,1,Z))
if 'Z
QUIT
Begin DoDot:2
+27 ; text line Z
SET TXT=$GET(^IBM(361,IBDA,1,Z,0))
if TXT=""
QUIT
+28 SET NOREVU=$$CKREVU^IBCEM4(TXT,,,.IBREV)
+29 ; 'review always needed' text found
IF IBREV
SET STOP=1
SET IBAUTO=0
QUIT
+30 ; 'no review needed' text found
IF NOREVU
SET IBAUTO=1
+31 QUIT
End DoDot:2
if STOP
QUIT
+32 IF IBAUTO
Begin DoDot:2
+33 NEW DIE,DR,DA
+34 SET DIE=361
SET DR=".09////2;.14////1;.1////F"
SET DA=IBDA
DO ^DIE
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
+37 DO MES^XPDUTL(" Done.")
+38 DO UPDATE^XPDID(3)
+39 DO CLEAN^DILF
+40 QUIT
+41 ;
MAIL(MTITLE,MLINES,MRECIP) ; send message
+1 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG
+2 SET XMSUB=MTITLE
SET XMDUZ=.5
SET XMTEXT="MLINES("
SET XMY(""_MRECIP_"")=""
+3 DO ^XMD
+4 QUIT
