- 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 Feb 19, 2025@00:00:20 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