source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBY368PO.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1IBY368PO ;YMG/BP - Post-Installation for IB patch 368 ;12-Mar-2007
2 ;;2.0;INTEGRATED BILLING;**368**;12-MAR-2007;Build 21
3 ;
4EN ;
5 N XPDIDTOT S XPDIDTOT=3
6 D NTFY ; 1. notify FSC that patch has been installed in production
7 D TEXT ; 2. add new text entries to file 361.3
8 D AUTOFILE ; 3. clean up stale informational messages in file 361
9 ;
10EX ;
11 Q
12 ;
13NTFY ; notify FSC that patch has been installed succesfully
14 N HEADER,BODY,MAILTO,SITE,TS
15 D BMES^XPDUTL(" STEP 1 of "_XPDIDTOT)
16 D MES^XPDUTL("-------------")
17 D MES^XPDUTL("Sending notification to FSC ...")
18 ; do not send notification if installed in test account
19 I '$$PROD^XUPROD D MES^XPDUTL("N/A for test account installation."),UPDATE^XPDID(1) Q
20 D DTNOLF^DICRW
21 S SITE=$$SITE^VASITE()
22 S HEADER="Patch IB*2.0*368 installed at VistA site "_$P(SITE,U,2)
23 D NOW^%DTC S TS=$$HLDATE^HLFNC(%,"TS")
24 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)
25 S BODY(.2)="Station Number: "_$P(SITE,U,3)
26 ; FSC destination address
27 ; FSC address for integration testing
28 S MAILTO="fsc.edi-team@va.gov"
29 D MAIL(HEADER,.BODY,MAILTO)
30 D MES^XPDUTL(" Done.")
31 D UPDATE^XPDID(1)
32 Q
33TEXT ; Add new text entries in file 361.3 - IB MESSAGE SCREEN TEXT
34 N DATA,TXT,DO,DA,DIC,X,Y
35 D BMES^XPDUTL(" STEP 2 of "_XPDIDTOT)
36 D MES^XPDUTL("-------------")
37 D MES^XPDUTL("Adding new entries into file 361.3 ....")
38 S DATA("ACCEPT")=0
39 S DATA("ACK/RECEIPT")=0
40 S DATA("CLAIM ACKNOWLEDGED AND FORWARD")=0
41 S DATA("FINAL/PAYMENT")=0
42 S DATA("PAPER CLAIM MAILED VIA USPS")=0
43 S DATA("ACCEPT *WARNING*")=1
44 S TXT="" F S TXT=$O(DATA(TXT)) Q:TXT="" D
45 .I $D(^IBE(361.3,"B",TXT)) Q ; already on file
46 .S DIC="^IBE(361.3,",DIC(0)="F",X=TXT
47 .S DIC("DR")=".02////"_DATA(TXT)
48 .D FILE^DICN
49 .Q
50TX ;
51 D MES^XPDUTL(" Done.")
52 D UPDATE^XPDID(2)
53 Q
54 ;
55AUTOFILE ; Check if informational status messages with no Final Review Action qualify for auto-file with no review.
56 ;
57 N IBDA,IBCNT,IB,Z,STOP,IBAUTO,TXT,NOREVU,IBREV
58 D BMES^XPDUTL(" STEP 3 of "_XPDIDTOT)
59 D MES^XPDUTL("-------------")
60 D MES^XPDUTL("Now looking at all informational status messages on file to see if any of them")
61 D MES^XPDUTL("can be auto-filed with no review needed. Each ""."" represents 1000 messages.")
62 D MES^XPDUTL("")
63 S IBDA=0,IBCNT=0 F S IBDA=$O(^IBM(361,"ASV","I",IBDA)) Q:'IBDA D
64 .S IBCNT=IBCNT+1 W:(IBCNT#1000=0)&'$D(ZTQUEUED) "."
65 .S IB=$G(^IBM(361,IBDA,0))
66 .I $P(IB,U,10)'="" Q ; final review action exists so quit out
67 .; if this message was previously auto-filed with no review, then
68 .; update the final review information and quit out
69 .I $P(IB,U,9)=2,$P(IB,U,14)=1 D Q
70 ..N DIE,DR,DA
71 ..S DIE=361,DR=".1////F",DA=IBDA D ^DIE
72 ..Q
73 .;
74 .; IBAUTO - flag indicating that the whole message can be auto-filed
75 .; with no review needed
76 .; NOREVU - flag indicating that one of the message lines had 'No
77 .; Review Needed' text
78 .; IBREV - flag indicating that one of the message lines had 'Review
79 .; Always Needed' text (so the whole message needs review)
80 .;
81 .S (Z,STOP,IBAUTO)=0 F S Z=$O(^IBM(361,IBDA,1,Z)) Q:'Z D Q:STOP
82 ..S TXT=$G(^IBM(361,IBDA,1,Z,0)) Q:TXT="" ; text line Z
83 ..S NOREVU=$$CKREVU^IBCEM4(TXT,,,.IBREV)
84 ..I IBREV S STOP=1,IBAUTO=0 Q ; 'review always needed' text found
85 ..I NOREVU S IBAUTO=1 ; 'no review needed' text found
86 ..Q
87 .I IBAUTO D
88 ..N DIE,DR,DA
89 ..S DIE=361,DR=".09////2;.14////1;.1////F",DA=IBDA D ^DIE
90 ..Q
91 .Q
92 D MES^XPDUTL(" Done.")
93 D UPDATE^XPDID(3)
94 D CLEAN^DILF
95 Q
96 ;
97MAIL(MTITLE,MLINES,MRECIP) ; send message
98 N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG
99 S XMSUB=MTITLE,XMDUZ=.5,XMTEXT="MLINES(",XMY(""_MRECIP_"")=""
100 D ^XMD
101 Q
Note: See TracBrowser for help on using the repository browser.