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

DG53A564.m

Go to the documentation of this file.
  1. DG53A564 ;ALB/PJR;POST INIT FOR PATCH 564 ; 6/9/04 3:51pm
  1. ;;5.3;Registration;**564**;Aug 13, 1993
  1. ;
  1. EP ;Main entry point of post init routine
  1. EN1 ;Queue seeding of new field
  1. ; Queue time is post install question POS1 (use NOW if not defined)
  1. ; If queued using entry point QUEUE, queue time will be prompted for
  1. N ZTSK,ZTRTN,ZTIO,ZTDESC,ZTDTH,Y9
  1. S X(1)=" "
  1. S X(2)=" "
  1. S X(3)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
  1. S X(4)="(#.3213) with VIETNAM for all patients claiming exposure"
  1. S X(5)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
  1. S X(6)="YES) and Exposure Location equals NULL will now be queued"
  1. S X(7)=" "
  1. D MES^XPDUTL(.X) K X
  1. I $D(^XTMP("DG53A564",2)) D Q
  1. .S X(1)=" "
  1. .S X(2)="*****"
  1. .S X(3)="Post init appears to be running. If it is not, delete the"
  1. .S X(4)="node ^XTMP(""DG53A564"",2) and use line tag QUEUE^DG53A564"
  1. .S X(5)="to [re]start the process."
  1. .S X(6)="*****"
  1. .S X(7)=" "
  1. .D MES^XPDUTL(.X) K X
  1. I $D(^XTMP("DG53A564",3)) D Q
  1. .S X(1)=" "
  1. .S X(2)="*****"
  1. .S X(3)="Post init appears to have run to completion on "_$$FMTE^XLFDT(^XTMP("DG53A564",3))_"."
  1. .S X(4)="If it did not, delete the node ^XTMP(""DG53A564"",3) and use"
  1. .S X(5)="line tag QUEUE^DG53A564 to [re]start the process."
  1. .S X(6)="*****"
  1. .S X(7)=" "
  1. .D MES^XPDUTL(.X) K X
  1. S ZTRTN="SET^DG53A564",ZTIO=""
  1. S ZTDTH=$H S X=+$G(XPDQUES("POS1")) S:(X) ZTDTH=$$FMTH^XLFDT(X) K:$G(DG53A564) ZTDTH
  1. S ZTDESC="Initial seeding of AGENT ORANGE EXPOSURE LOCATION field"
  1. D ^%ZTLOAD
  1. I $G(ZTSK) D MES^XPDUTL("Task #"_ZTSK_" queued to start "_$$HTE^XLFDT($G(ZTSK("D")))) I 1
  1. E D MES^XPDUTL("***** UNABLE TO QUEUE INITIAL SEEDING *****")
  1. Q
  1. ;
  1. SET ; This is the post-init to make sure all patients claiming
  1. ; exposure to agent orange have a selected location for the
  1. ; exposure. The initial setting is Vietnam.
  1. N AOCNT,DFNCNT,DATIM,DFN,QFLG,Y,XMSUB,XMDUZ,XMTEXT,XMY,LASTDFN
  1. S DATIM=$$DT^XLFDT()
  1. S ^XTMP("DG53A564",0)=$$FMADD^XLFDT(DATIM,30)_"^"_DATIM
  1. S ^XTMP("DG53A564",2)=1
  1. S QFLG=0
  1. S Y=$G(^XTMP("DG53A564",1))
  1. S (DFN,LASTDFN)=+Y,DFNCNT=+$P(Y,"^",2),AOCNT=+$P(Y,"^",3)
  1. F S DFN=$O(^DPT(DFN)) Q:'DFN D Q:QFLG
  1. .S DFNCNT=DFNCNT+1
  1. .S LASTDFN=DFN
  1. .S Y9=$G(^DPT(DFN,.321)) I $P(Y9,U,2)="Y",$P(Y9,U,13)="" D
  1. ..S (DA,Y)=DFN,DIE="^DPT(",DR=".3213///VIETNAM" D ^DIE S AOCNT=AOCNT+1
  1. .I '(DFNCNT#1000) S QFLG=$$S^%ZTLOAD("DFN: "_DFN) H 1
  1. S ^XTMP("DG53A564",1)=LASTDFN_"^"_DFNCNT_"^"_AOCNT
  1. K ^XTMP("DG53A564",2)
  1. S DATIM=$$NOW^XLFDT()
  1. I QFLG D I 1
  1. .S ZTSTOP=1
  1. .S Y=$$S^%ZTLOAD("STOPPED PROCESSING AT DFN "_LASTDFN)
  1. E D
  1. .S ^XTMP("DG53A564",3)=DATIM
  1. .S ZTREQ="@"
  1. S XMSUB="DG*5.3*564A post init has run to completion."
  1. S:(QFLG) XMSUB="DG*5.3*564A post init was asked to stop."
  1. K ^TMP($J,"DG53A564")
  1. S ^TMP($J,"DG53A564",1,0)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
  1. S ^TMP($J,"DG53A564",2,0)="(#.3213) with VIETNAM for all patients claiming exposure"
  1. S ^TMP($J,"DG53A564",3,0)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
  1. S ^TMP($J,"DG53A564",4,0)="YES) and Exposure Location equals NULL"
  1. S ^TMP($J,"DG53A564",5,0)="ran to completion on "_$$FMTE^XLFDT(DATIM)_"."
  1. S ^TMP($J,"DG53A564",6,0)=" "
  1. S ^TMP($J,"DG53A564",7,0)="Post init routine DG53A564 can be deleted."
  1. I QFLG D
  1. .S ^TMP($J,"DG53A564",4,0)="YES) was asked to stop on "_$$FMTE^XLFDT(DATIM)_"."
  1. .S ^TMP($J,"DG53A564",5,0)=" "
  1. .S ^TMP($J,"DG53A564",6,0)="Use the entry point QUEUE^DG53A564 to resume seeding."
  1. S XMDUZ="Patch DG*5.3*564A"
  1. S XMTEXT="^TMP($J,""DG53A564"","
  1. S XMY(DUZ)=""
  1. D ^XMD
  1. K ^TMP($J,"DG53A564")
  1. S ZTREQ="@"
  1. Q
  1. ;
  1. QUEUE ;Line tag for field to use to requeue seeding
  1. N X,DG53A564
  1. S DG53A564=1
  1. D EN1
  1. Q