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