source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCDXUTL5.m@ 1780

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1SCDXUTL5 ;ALB/ABR - RETRANSMIT CORRECTED HL7 UTILITY ; 10/25/96
2 ;;5.3;Scheduling;**70**;AUG 13, 1993
3 ;
4EN ;
5 N DA,DIE,DR,ENC,ENCNODE,II,SDDATE,SDDAY,SDEN,SDN,SDPATCH,X,X1,X2
6 ; +SDPATCH = date/time of patch install
7 ; SDDATE = last date run (starting point for today's run
8 S SDPATCH=$G(^SD(404.91,1,"PATCH70")) Q:'SDPATCH
9 S (SDDATE,X1)=$P(SDPATCH,U,2),X2=3
10 Q:'SDDATE ;update complete
11 ;
12 D C^%DTC ; find date + 3
13 S $P(SDDATE,".",2)=9,SDDAY=$P(X,".") I SDDAY>DT S SDDAY=DT ; cannot be greater than today
14 S SDEND=SDDAY+.9,SDSTA=SDDATE ; end date, start from date
15 ;
16 D DELTX
17 D NOXMIT
18 D SETFL
19 I SDDATE,SDDAY<DT S $P(^SD(404.91,1,"PATCH70"),U,2)=SDDAY G ENQ
20 D CLNDONE
21ENQ Q
22 ;
23DELTX ; deleted encounters
24 N SDEL
25 S SDEL=0
26 F S SDEL=$O(^SD(409.73,"ADEL",SDEL)) Q:'SDEL D
27 . I +$G(^SD(409.74,SDEL,0))<SDDATE Q ; quit if delete for already xmited enc.
28 . S SDN=$O(^SD(409.73,"ADEL",SDEL,0))
29 . ; clean out files, reset 0-nodes
30 . D KILL("^SD(409.74,",SDEL)
31 . D:SDN KILL("^SD(409.73,",SDN)
32 Q
33KILL(DIK,DA) ; cleans out deleted encounters
34 D ^DIK
35 Q
36 ;
37NOXMIT ; don't transmit encounters out of date range
38 N SDX,SDX1
39 S SDX=0
40 F S SDX=$O(^SD(409.73,"AACXMIT",SDX)) Q:'SDX D
41 . F SDX1=0:0 S SDX1=$O(^SD(409.73,"AACXMIT",SDX,SDX1)) Q:'SDX1 D
42 ..; check if encounter beyond today's send range
43 .. S SDEN=+$P($G(^SD(409.73,SDX1,0)),U,2) Q:'SDEN I $G(^SCE(SDEN,0))>SDEND!('$G(^SCE(SDEN,0))) D
44 ...S DIE="^SD(409.73,",DA=SDX1,DR=".04////0" D ^DIE
45 Q
46SETFL ; loop checks encounters transmitted up through date/time of patch installation
47 F S SDDATE=$O(^SCE("B",SDDATE)) Q:'SDDATE!(SDDATE>SDEND) D
48 . F SDEN=0:0 S SDEN=$O(^SCE("B",SDDATE,SDEN)) Q:'SDEN S SDN=$O(^SD(409.73,"AENC",SDEN,0)) I SDN D
49 .. ; quit if xmit date after patch install or already set to YES
50 .. Q:($G(^SD(409.73,SDN,1))>SDPATCH)!$P($G(^(0)),U,4)
51 .. S DIE="^SD(409.73,",DR=".04////1",DA=SDN D ^DIE
52 Q
53 ;
54CLNDONE ; cleanup done
55 ;update node and create bulletin
56 S $P(^SD(404.91,1,"PATCH70"),U,2)=""
57 ;
58MSG N MSGTXT,XMB,XMTEXT,XMY,XMDUZ,XMDT,XMZ,DIFROM
59 S XMB="SCDX AMBCARE TO NPCDB SUMMARY"
60 ; recipients are same as for SCDX AMBCARE TO NPCDB SUMMARY bulletin
61 ; and group at Albany IRMFO
62 S XMY("G.ACRP MAINTENANCE@ISC-ALBANY")=""
63 S XMB(1)="** HL7 TRANSMISSIONS UP-TO-DATE **" ;subject
64 ; message text
65 S MSGTXT(1)="Patch SD*5.3*70 began retransmitting Ambulatory Care Reporting Project"
66 S MSGTXT(2)="(ACRP) data beginning with encounters on 10/1. The retransmission of past"
67 S MSGTXT(3)="workload is now complete. The nightly background job will now resume"
68 S MSGTXT(4)="normal operations."
69 S XMTEXT="MSGTXT("
70 ;
71 D ^XMB
72 Q
Note: See TracBrowser for help on using the repository browser.