Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDRPA04

SDRPA04.m

Go to the documentation of this file. 
  1. SDRPA04 ;BP-OIFO/ESW - SDRPA00 continuation PAIT - REPAIR  ; 11/2/04 11:47am  ; 5/31/07 5:29pm
  1.  ;;5.3;Scheduling;**376,491,1015**;Aug 13, 1993;Build 21
  1.  ;SD/491 - not to error out while repairing with acks having received
  1.  Q
  1. MSGT(CRUNID,SDPEN,SDFIN,SDTOT,SDSTOP) ;create completion messages
  1.  ;CRUNID - current run number
  1.  ;SDPEN  - pendings
  1.  ;SDFIN  - finals
  1.  ;SDTOT  - total
  1.  ;SDSTOP - task stop flag
  1.  N SDB,SDTRF
  1.  I '$D(SDTOT) S SDTOT=SDPEN+SDFIN
  1.  N SFF S SFF=0
  1.  I +SDTOT=0 S (SDPEN,SDFIN)=0,SFF=1
  1.  I '$D(SDPEN),'$D(SDFIN) S (SDPEN,SDFIN)="undetermined",SFF=1
  1.  N SDB,SDTRF
  1.  S SDB=SDTOT\5000 I SDTOT-(5000*SDB)>0 S SDB=SDB+1 ;# of batches
  1.  N NOW S NOW=$$NOW^XLFDT S SDTRF=$$FMTE^XLFDT(NOW,2),SDTRF=$P(SDTRF,":",1,2)
  1.  N DA,DIE,DR D
  1.  .S DA=CRUNID,DIE=409.6,DR="1.3///"_SDTOT_";1.4///"_SDB_";1.5///"_NOW D ^DIE
  1.  D CLEAN(CRUNID)
  1.  N SDS,SDSTAT,SDIP,SDAR,SDAP,SDMT,SDMS,SD870
  1.  ;SDS - STATION #
  1.  ;SDSTAT - SD-PAIT STATUS
  1.  ;SDAIP  - IP ADDRESS
  1.  ;SDAR   - COMMIT ACK RECEIVED
  1.  ;SDAP   - COMMIT ACK PROCESSED
  1.  ;SDMT   - MESSAGES (BATCHES) TO SEND
  1.  ;SDMS   - MESSAGES (BATCHES) SENT
  1.  S SD870=$O(^HLCS(870,"B","SD-PAIT",""))
  1.  N ARRAY D GETS^DIQ(870,SD870_",","4;5;6;7;8;400.01","I","ARRAY")
  1.  N SD87 S SD87=SD870_","
  1.  S SDSTAT=ARRAY(870,SD87,4,"I")
  1.  S SDAR=ARRAY(870,SD87,5,"I")
  1.  S SDAP=ARRAY(870,SD87,6,"I")
  1.  S SDMS=ARRAY(870,SD87,7,"I")
  1.  S SDMT=ARRAY(870,SD87,8,"I")
  1.  S SDIP=ARRAY(870,SD87,400.01,"I")
  1.  S SDS=$P($$SITE^VASITE(),"^",3)
  1.  ;S SDS=$E($O(^SDWL(409.6,"AMSG","")),1,3)
  1.  N SDBT,STSK,SDSL ; Starting and Last scanned date
  1.  S SDBT=$P(^SDWL(409.6,CRUNID,0),U),SDSL=$P(^SDWL(409.6,CRUNID,0),U,4)
  1.  S STSK=$P(^SDWL(409.6,CRUNID,0),U,2)
  1.  S SDBT=$$FMTE^XLFDT(SDBT,2),SDSL=$$FMTE^XLFDT(SDSL,2)
  1. MSG ;send mail message
  1.  N SDAMX,XMSUB,XMY,XMTEXT,XMDUZ
  1.  S XMSUB=$G(SDS)_" - PAIT BACKGROUND JOB"
  1.  S XMY("G.SD-PAIT")=""
  1.  S XMY("S.SD-PAIT-SERVER@FORUM.VA.GOV")=""
  1.  S XMTEXT="SDAMX("
  1.  S DUZ=""
  1.  S XMDUZ="POSTMASTER"
  1.  S SDAMX(1)=""
  1.  S SDAMX(2)="The PAIT job has completed - TASK #: "_STSK_" Log #: "_CRUNID_" on "_SDTRF
  1.  S SDAMX(3)="Started: "_SDBT_"                        Last Scanned: "_SDSL
  1.  S SDAMX(4)="Pending appointments: "_$J(SDPEN,10)
  1.  S SDAMX(5)="Final appointments:   "_$J(SDFIN,10)
  1.  S SDAMX(6)="                       ----------"
  1.  S SDAMX(7)="Total appointments:   "_$J(SDTOT,10)_"   Number of batches: "_SDB
  1.  S SDAMX(8)=""
  1.  S SDAMX(9)="Fac Log Bch Appt #  Date finished  IP Address  Gen  Sent Com R Com P  Status"
  1.  S SDAMX(10)="-----------------------------------------------------------------------"
  1.  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
  1.  S SDAMX(12)=""
  1.  I $G(SDSTOP) S XMY("VHACIONHD@MED.VA.GOV")="" D  D ^XMD Q
  1.  .S SDAMX(13)="WARNING: TASK STOPPED BY USER, NEEDS TO BE RESTARTED."
  1.  .S SDAMX(14)="Initiate a Remedy ticket TO FOLLOW UP."
  1.  I 'SFF I SDMT>0!(SDB=0) D  D ^XMD K ^TMP("SDDPT",$J) Q
  1.  .I (SDMT-SDMS)=0 D  Q
  1.  ..S SDAMX(13)="SUCCESS: Transmission completed."
  1.  .I (SDMT-SDMS)<SDB!(SDB=1&(SDMT-SDMS)'<SDB)&(SDSTAT'["Shutdown") D  Q
  1.  ..S SDAMX(13)="WARNING: "_(SDMT-SDMS)_" out of "_SDB_" batches still have to be transmitted,"
  1.  ..S SDAMX(14)="please verify with the HL7 System Monitor."
  1.  .S XMY("VHACIONHD@MED.VA.GOV")=""
  1.  .I SDB>0 I (SDMT-SDMS)'<SDB D  Q
  1.  ..S XMY("VHACIONHD@MED.VA.GOV")=""
  1.  ..I SDSTAT["Shutdown" D
  1.  ...S SDAMX(13)="SD-PAIT Logical Link has to be started, initiate Remedy ticket for Scheduling PAIT."
  1.  ..E  S SDAMX(13)="Initiate a Remedy ticket for Interface Engine - communication problem."
  1.  I SFF D  D ^XMD K ^TMP("SDDPT",$J) Q
  1.  .S SDAMX(13)="WARNING!!!: Transmission of run#: "_CRUNID_" has been repaired, you may restart."
  1.  .I SDB>0 I (SDMT-SDMS)'<SDB D
  1.  ..S XMY("VHACIONHD@MED.VA.GOV")=""
  1.  ..I SDSTAT["Shutdown" D  Q
  1.  ...S SDAMX(14)="SD-PAIT Logical Link has to be started, initiate Remedy ticket for Scheduling PAIT."
  1.  ..S SDAMX(14)="Initiate a Remedy ticket for Interface Engine - communication problem."
  1.  Q
  1. CLEAN(CRUNID) ;housekeeping
  1.  ;clean up batches previous to current one by checking for "AE",("S" or "R") xref and
  1.  ;deleting if entry in xref exists
  1.  ;RUN  :  run #           (ien of multiple entry)
  1.  ;V1   :  previous run #  (ien of multiple entry)  
  1.  ;V2   :  ien           (ien in multiple)
  1.  N V1,V2,V3,ZNODE,DIK
  1.  S V1=CRUNID F  S V1=$O(^SDWL(409.6,V1),-1) Q:'V1  D
  1.  .F V3="R","S" S V2=0 F  S V2=$O(^SDWL(409.6,"AE",V3,V1,V2)) Q:'V2  D
  1.  ..S ZNODE=$G(^SDWL(409.6,V1,1,V2,0))
  1.  ..S ^XTMP("SDRPA-"_$P(ZNODE,"^",3),0)=$$HTFM^XLFDT($H+7,1)_U_$$HTFM^XLFDT($H,1)
  1.  ..S DIK="^SDWL(409.6,"_V1_",1,"
  1.  ..S DA(1)=V1,DA=V2 D ^DIK
  1.  ..S ^XTMP("SDRPA-"_$P(ZNODE,"^",3),"CLEAN",+$P(ZNODE,"^",4),0)=ZNODE ;diagnostics
  1.  Q
  1. RPAIT(RUN) ;
  1.  ;RUN - run number - entry ^SDWL(409.6,RUN,0) to be repaired
  1.  Q:+$G(RUN)'>1
  1.  W !,"The repairing in progress...",!
  1.  N SDE,SDEB,SDFE,SDLSD,SDRCNT,ZTSK
  1.  S SDE=$G(^SDWL(409.6,RUN,0)) Q:SDE=""
  1.  S ZTSK=$P(SDE,"^",2) D STAT^%ZTLOAD I ZTSK(1)=1!(ZTSK(1)=2) W !,"Task "_ZTSK_"is still active!" Q
  1.  S SDEB=+$P(SDE,"^",3) ; last batch # submitted to HL7
  1.  S SDRCNT=$O(^SDWL(409.6,RUN,1,999999999),-1) ;last entry
  1.  I SDEB=0 S SDFE=0 S $P(^SDWL(409.6,RUN,0),U,4)=$P(^SDWL(409.6,RUN-1,0),U,4)
  1.  I +SDEB>0 D
  1.  .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
  1.  .N SDLSD1 S SDLSD1=$P(^SDWL(409.6,RUN,1,SDFE,0),U,7) ;retrieve the last used creation date of HL7 created 
  1.  .N SDLSD2 S SDLSD2=$P($G(^SDWL(409.6,RUN,1,SDFE+1,0)),U,7)
  1.  .S SDLSD=$P(SDE,U,4) ; last scanned date
  1.  .I SDLSD="" D
  1.  ..S $P(^SDWL(409.6,RUN,0),U,4)=$S(SDLSD2>SDLSD1:SDLSD1,1:SDLSD1-1)
  1.  .E  S $P(^SDWL(409.6,RUN,0),U,4)=SDLSD-1
  1.  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
  1.  S SDB=+$P($G(^SDWL(409.6,RUN,2,0)),U,3)
  1.  S NOW=$$NOW^XLFDT,SDFE=5000*SDB
  1.  S $P(^SDWL(409.6,RUN,0),U,5)=SDFE
  1.  S $P(^SDWL(409.6,RUN,0),U,6)=SDB
  1.  S $P(^SDWL(409.6,RUN,0),U,7)=NOW
  1.  D MSGT(RUN,,,SDFE)
  1.  W !!,"The last run number has been repaired, you may ONE TIME QUEUE the next one.",!
  1.  Q
  1. EVAL(RUN,SDS) ;
  1.  ;evaluate if to update any 'S' or 'R' Retention Flags for
  1.  ;the previous entry if exists.
  1.  N SDSTR,DFN,SDDT S SDSTR=^SDWL(409.6,RUN,1,SDS,0)
  1.  S DFN=+SDSTR,SDDT=$P(SDSTR,"^",2)
  1.  Q:SDDT=""
  1.  ;find a prior entry SDRUN
  1.  N SDRUN S SDRUN=$O(^SDWL(409.6,"AC",DFN,SDDT,RUN),-1) Q:SDRUN=""
  1.  N SDSQ S SDSQ=$O(^SDWL(409.6,"AC",DFN,SDDT,SDRUN,""))
  1.  N SDSTRP S SDSTRP=^SDWL(409.6,SDRUN,1,SDSQ,0)
  1.  N SDRET S SDRET=$P(SDSTRP,"^",5)
  1.  I SDRET="S"!(SDRET="R") N DIC D
  1.  .S SDRET="Y",DIC="^SDWL(409.6,"_SDRUN_",1,",DA(1)=SDRUN,DA=SDSQ,DIE=DIC,DR="4///"_SDRET D ^DIE
  1.  Q