source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDRPA03.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1SDRPA03 ;BP-OIFO/ESW - PAIT - SDRPA00 continuation ; 11/2/04 10:09am
2 ;;5.3;Scheduling;**349,376**;Aug 13, 1993
3 Q
4MSGT(CRUNID,SDPEN,SDFIN,SDTOT,SDSTOP) ;create completion messages
5 ;CRUNID - current run number
6 ;SDPEN - pendings
7 ;SDFIN - finals
8 ;SDTOT - total
9 ;SDSTOP - task stop flag
10 N SDB,SDTRF
11 I '$D(SDTOT) S SDTOT=SDPEN+SDFIN
12 N SFF S SFF=0
13 I +SDTOT=0 S (SDPEN,SDFIN)=0,SFF=1
14 I '$D(SDPEN),'$D(SDFIN) S (SDPEN,SDFIN)="undetermined",SFF=1
15 N SDB,SDTRF
16 S SDB=SDTOT\5000 I SDTOT-(5000*SDB)>0 S SDB=SDB+1 ;# of batches
17 N NOW S NOW=$$NOW^XLFDT S SDTRF=$$FMTE^XLFDT(NOW,2),SDTRF=$P(SDTRF,":",1,2)
18 N DA,DIE,DR D
19 .S DA=CRUNID,DIE=409.6,DR="1.3///"_SDTOT_";1.4///"_SDB_";1.5///"_NOW D ^DIE
20 D CLEAN(CRUNID)
21 N SDS,SDSTAT,SDIP,SDAR,SDAP,SDMT,SDMS,SD870
22 ;SDS - STATION #
23 ;SDSTAT - SD-PAIT STATUS
24 ;SDAIP - IP ADDRESS
25 ;SDAR - COMMIT ACK RECEIVED
26 ;SDAP - COMMIT ACK PROCESSED
27 ;SDMT - MESSAGES (BATCHES) TO SEND
28 ;SDMS - MESSAGES (BATCHES) SENT
29 S SD870=$O(^HLCS(870,"B","SD-PAIT",""))
30 N ARRAY D GETS^DIQ(870,SD870_",","4;5;6;7;8;400.01","I","ARRAY")
31 N SD87 S SD87=SD870_","
32 S SDSTAT=ARRAY(870,SD87,4,"I")
33 S SDAR=ARRAY(870,SD87,5,"I")
34 S SDAP=ARRAY(870,SD87,6,"I")
35 S SDMS=ARRAY(870,SD87,7,"I")
36 S SDMT=ARRAY(870,SD87,8,"I")
37 S SDIP=ARRAY(870,SD87,400.01,"I")
38 S SDS=$P($$SITE^VASITE(),"^",3)
39 ;S SDS=$E($O(^SDWL(409.6,"AMSG","")),1,3)
40 N SDBT,STSK,SDSL ; Starting and Last scanned date
41 S SDBT=$P(^SDWL(409.6,CRUNID,0),U),SDSL=$P(^SDWL(409.6,CRUNID,0),U,4)
42 S STSK=$P(^SDWL(409.6,CRUNID,0),U,2)
43 S SDBT=$$FMTE^XLFDT(SDBT,2),SDSL=$$FMTE^XLFDT(SDSL,2)
44MSG ;send mail message
45 N SDAMX,XMSUB,XMY,XMTEXT,XMDUZ
46 S XMSUB=$G(SDS)_" - PAIT BACKGROUND JOB"
47 S XMY("G.SD-PAIT")=""
48 S XMY("S.SD-PAIT-SERVER@FORUM.VA.GOV")=""
49 S XMTEXT="SDAMX("
50 S DUZ="" S XMDUZ="POSTMASTER"
51 S SDAMX(1)=""
52 S SDAMX(2)="The PAIT job has completed - TASK #: "_STSK_" Log #: "_CRUNID_" on "_SDTRF
53 S SDAMX(3)="Started: "_SDBT_" Last Scanned: "_SDSL
54 S SDAMX(4)="Pending appointments: "_$J(SDPEN,10)
55 S SDAMX(5)="Final appointments: "_$J(SDFIN,10)
56 S SDAMX(6)=" ----------"
57 S SDAMX(7)="Total appointments: "_$J(SDTOT,10)_" Number of batches: "_SDB
58 S SDAMX(8)=""
59 S SDAMX(9)="Fac Log Bch Appt # Date finished IP Address Gen Sent Com R Com P Status"
60 S SDAMX(10)="-----------------------------------------------------------------------"
61 S SDAMX(11)=SDS_"|"_$J(CRUNID,3)_"|"_$J(SDB,3)_"|"_$J(SDTOT,7)_"|"_SDTRF_"|"_$J(SDIP,11)_"|"_$J(SDMT,4)_"|"_$J(SDMS,4)_"|"_$J(SDAR,4)_"|"_$J(SDAP,4)_"| "_SDSTAT
62 S SDAMX(12)=""
63 I $G(SDSTOP) S XMY("VHACIONHD@MED.VA.GOV")="" D D ^XMD Q
64 .S SDAMX(13)="WARNING: TASK STOPPED BY USER, NEEDS TO BE RESTARTED."
65 .S SDAMX(14)="INITIATE a NOIS TO FOLLOW UP."
66 I 'SFF I SDMT>0!(SDB=0) D D ^XMD Q
67 .I (SDMT-SDMS)=0 D Q
68 ..S SDAMX(13)="SUCCESS: Transmission completed."
69 .I (SDMT-SDMS)<SDB D Q
70 ..S SDAMX(13)="WARNING: "_(SDMT-SDMS)_" out of "_SDB_" still have to be transmitted,"
71 ..S SDAMX(14)="please verify with the HL7 System Monitor."
72 .S XMY("VHACIONHD@MED.VA.GOV")=""
73 .I SDMT-SDMS'<SDB D Q
74 ..S XMY("VHACIONHD@MED.VA.GOV")=""
75 ..I SDSTAT["Shutdown" S SDAMX(13)="SD-PAIT Logical Link has to be started!"
76 ..E S SDAMX(13)="Initiate a NOIS for VistA Interface Engine - communication problem."
77 ;D ^XMD
78 K ^TMP("SDDPT",$J)
79 Q
80CLEAN(CRUNID) ;housekeeping
81 ;clean up batches previous to current one by checking for "AE",("S" or "R") xref and
82 ;deleting if entry in xref exists
83 ;RUN : run # (ien of multiple entry)
84 ;V1 : previous run # (ien of multiple entry)
85 ;V2 : ien (ien in multiple)
86 N V1,V2,V3,ZNODE,DIK
87 S V1=CRUNID F S V1=$O(^SDWL(409.6,V1),-1) Q:'V1 D
88 .F V3="R","S" S V2=0 F S V2=$O(^SDWL(409.6,"AE",V3,V1,V2)) Q:'V2 D
89 ..S ZNODE=$G(^SDWL(409.6,V1,1,V2,0))
90 ..S ^XTMP("SDRPA-"_$P(ZNODE,"^",3),0)=$$HTFM^XLFDT($H+7,1)_U_$$HTFM^XLFDT($H,1)
91 ..S DIK="^SDWL(409.6,"_V1_",1,"
92 ..S DA(1)=V1,DA=V2 D ^DIK
93 ..S ^XTMP("SDRPA-"_$P(ZNODE,"^",3),"CLEAN",+$P(ZNODE,"^",4),0)=ZNODE ;diagnostics
94 Q
95RPAIT(RUN) ;
96 ;RUN - run number - entry ^SDWL(409.6,RUN,0) to be repaired
97 N SDE,SDEB,SDFE,SDLSD,SDRCNT,SDLSD1,SDLSD2
98 Q:+$G(RUN)'>1
99 S SDE=$G(^SDWL(409.6,RUN,0)) Q:SDE=""
100 S SDEB=+$P(SDE,"^",3) ; last batch # submitted to HL7
101 S SDRCNT=$O(^SDWL(409.6,RUN,1,999999999),-1) ;last entry
102 I SDEB=0 S SDFE=0 S $P(^SDWL(409.6,RUN,0),U,4)=$P(^SDWL(409.6,RUN-1,0),U,4)
103 I +SDEB>0 D
104 .S SDFE=SDRCNT+1 F S SDFE=$O(^SDWL(409.6,RUN,1,SDFE),-1) I $P(^SDWL(409.6,RUN,1,SDFE,0),U,3)=SDEB Q ; last accepted entry
105 .S SDLSD1=$P(^SDWL(409.6,RUN,1,SDFE,0),U,7) ;retrieve the last used creation date of HL7 created
106 .S SDLSD2=$P(^SDWL(409.6,RUN,1,SDFE+1,0),U,7)
107 .S SDLSD=$P(SDE,U,4) ; last scanned date
108 .I SDLSD="" D
109 ..S $P(^SDWL(409.6,RUN,0),U,4)=$S(SDLSD2>SDLSD1:SDLSD1,1:SDLSD1-1)
110 .E S $P(^SDWL(409.6,RUN,0),U,4)=SDLSD-1
111 N SDS F SDS=SDFE+1:1:SDRCNT D EVAL(RUN,SDS) S DIK="^SDWL(409.6,"_RUN_",1,",DA(1)=RUN,DA=SDS D ^DIK
112 S SDB=SDFE\5000 I SDFE-(5000*SDB)>0 S SDB=SDB+1
113 S NOW=$$NOW^XLFDT
114 S $P(^SDWL(409.6,RUN,0),U,5)=SDFE
115 S $P(^SDWL(409.6,RUN,0),U,6)=SDB
116 S $P(^SDWL(409.6,RUN,0),U,7)=NOW
117 D MSGT(RUN,,,SDFE)
118 Q 1
119EVAL(RUN,SDS) ;
120 ;evaluate if to update any 'S' or 'R' Retention Flags for
121 ;the previous entry if exists.
122 N SDSTR,DFN,SDDT S SDSTR=^SDWL(409.6,RUN,1,SDS,0)
123 S DFN=+SDSTR,SDDT=$P(SDSTR,"^",2)
124 ;find a prior entry SDRUN
125 N SDRUN S SDRUN=$O(^SDWL(409.6,"AC",DFN,SDDT,RUN),-1) Q:SDRUN=""
126 N SDSQ S SDSQ=$O(^SDWL(409.6,"AC",DFN,SDDT,SDRUN,""))
127 N SDSTRP S SDSTRP=^SDWL(409.6,SDRUN,1,SDSQ,0)
128 N SDRET,DIC S SDRET=$P(SDSTRP,"^",5) I SDRET="S"!(SDRET="R") D
129 .S SDRET="Y",DIC="^SDWL(409.6,"_SDRUN_",1,",DA(1)=SDRUN,DA=SDSQ,DIE=DIC,DR="4///"_SDRET D ^DIE
130 Q
Note: See TracBrowser for help on using the repository browser.