[613] | 1 | DG53A564 ;ALB/PJR;POST INIT FOR PATCH 564 ; 6/9/04 3:51pm
|
---|
| 2 | ;;5.3;Registration;**564**;Aug 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | EP ;Main entry point of post init routine
|
---|
| 5 | EN1 ;Queue seeding of new field
|
---|
| 6 | ; Queue time is post install question POS1 (use NOW if not defined)
|
---|
| 7 | ; If queued using entry point QUEUE, queue time will be prompted for
|
---|
| 8 | N ZTSK,ZTRTN,ZTIO,ZTDESC,ZTDTH,Y9
|
---|
| 9 | S X(1)=" "
|
---|
| 10 | S X(2)=" "
|
---|
| 11 | S X(3)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
|
---|
| 12 | S X(4)="(#.3213) with VIETNAM for all patients claiming exposure"
|
---|
| 13 | S X(5)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
|
---|
| 14 | S X(6)="YES) and Exposure Location equals NULL will now be queued"
|
---|
| 15 | S X(7)=" "
|
---|
| 16 | D MES^XPDUTL(.X) K X
|
---|
| 17 | I $D(^XTMP("DG53A564",2)) D Q
|
---|
| 18 | .S X(1)=" "
|
---|
| 19 | .S X(2)="*****"
|
---|
| 20 | .S X(3)="Post init appears to be running. If it is not, delete the"
|
---|
| 21 | .S X(4)="node ^XTMP(""DG53A564"",2) and use line tag QUEUE^DG53A564"
|
---|
| 22 | .S X(5)="to [re]start the process."
|
---|
| 23 | .S X(6)="*****"
|
---|
| 24 | .S X(7)=" "
|
---|
| 25 | .D MES^XPDUTL(.X) K X
|
---|
| 26 | I $D(^XTMP("DG53A564",3)) D Q
|
---|
| 27 | .S X(1)=" "
|
---|
| 28 | .S X(2)="*****"
|
---|
| 29 | .S X(3)="Post init appears to have run to completion on "_$$FMTE^XLFDT(^XTMP("DG53A564",3))_"."
|
---|
| 30 | .S X(4)="If it did not, delete the node ^XTMP(""DG53A564"",3) and use"
|
---|
| 31 | .S X(5)="line tag QUEUE^DG53A564 to [re]start the process."
|
---|
| 32 | .S X(6)="*****"
|
---|
| 33 | .S X(7)=" "
|
---|
| 34 | .D MES^XPDUTL(.X) K X
|
---|
| 35 | S ZTRTN="SET^DG53A564",ZTIO=""
|
---|
| 36 | S ZTDTH=$H S X=+$G(XPDQUES("POS1")) S:(X) ZTDTH=$$FMTH^XLFDT(X) K:$G(DG53A564) ZTDTH
|
---|
| 37 | S ZTDESC="Initial seeding of AGENT ORANGE EXPOSURE LOCATION field"
|
---|
| 38 | D ^%ZTLOAD
|
---|
| 39 | I $G(ZTSK) D MES^XPDUTL("Task #"_ZTSK_" queued to start "_$$HTE^XLFDT($G(ZTSK("D")))) I 1
|
---|
| 40 | E D MES^XPDUTL("***** UNABLE TO QUEUE INITIAL SEEDING *****")
|
---|
| 41 | Q
|
---|
| 42 | ;
|
---|
| 43 | SET ; This is the post-init to make sure all patients claiming
|
---|
| 44 | ; exposure to agent orange have a selected location for the
|
---|
| 45 | ; exposure. The initial setting is Vietnam.
|
---|
| 46 | N AOCNT,DFNCNT,DATIM,DFN,QFLG,Y,XMSUB,XMDUZ,XMTEXT,XMY,LASTDFN
|
---|
| 47 | S DATIM=$$DT^XLFDT()
|
---|
| 48 | S ^XTMP("DG53A564",0)=$$FMADD^XLFDT(DATIM,30)_"^"_DATIM
|
---|
| 49 | S ^XTMP("DG53A564",2)=1
|
---|
| 50 | S QFLG=0
|
---|
| 51 | S Y=$G(^XTMP("DG53A564",1))
|
---|
| 52 | S (DFN,LASTDFN)=+Y,DFNCNT=+$P(Y,"^",2),AOCNT=+$P(Y,"^",3)
|
---|
| 53 | F S DFN=$O(^DPT(DFN)) Q:'DFN D Q:QFLG
|
---|
| 54 | .S DFNCNT=DFNCNT+1
|
---|
| 55 | .S LASTDFN=DFN
|
---|
| 56 | .S Y9=$G(^DPT(DFN,.321)) I $P(Y9,U,2)="Y",$P(Y9,U,13)="" D
|
---|
| 57 | ..S (DA,Y)=DFN,DIE="^DPT(",DR=".3213///VIETNAM" D ^DIE S AOCNT=AOCNT+1
|
---|
| 58 | .I '(DFNCNT#1000) S QFLG=$$S^%ZTLOAD("DFN: "_DFN) H 1
|
---|
| 59 | S ^XTMP("DG53A564",1)=LASTDFN_"^"_DFNCNT_"^"_AOCNT
|
---|
| 60 | K ^XTMP("DG53A564",2)
|
---|
| 61 | S DATIM=$$NOW^XLFDT()
|
---|
| 62 | I QFLG D I 1
|
---|
| 63 | .S ZTSTOP=1
|
---|
| 64 | .S Y=$$S^%ZTLOAD("STOPPED PROCESSING AT DFN "_LASTDFN)
|
---|
| 65 | E D
|
---|
| 66 | .S ^XTMP("DG53A564",3)=DATIM
|
---|
| 67 | .S ZTREQ="@"
|
---|
| 68 | S XMSUB="DG*5.3*564A post init has run to completion."
|
---|
| 69 | S:(QFLG) XMSUB="DG*5.3*564A post init was asked to stop."
|
---|
| 70 | K ^TMP($J,"DG53A564")
|
---|
| 71 | S ^TMP($J,"DG53A564",1,0)="Routine to populate AGENT ORANGE EXPOSURE LOCATION field"
|
---|
| 72 | S ^TMP($J,"DG53A564",2,0)="(#.3213) with VIETNAM for all patients claiming exposure"
|
---|
| 73 | S ^TMP($J,"DG53A564",3,0)="to agent orange (AGENT ORANGE EXPOS. INDICATED? equals"
|
---|
| 74 | S ^TMP($J,"DG53A564",4,0)="YES) and Exposure Location equals NULL"
|
---|
| 75 | S ^TMP($J,"DG53A564",5,0)="ran to completion on "_$$FMTE^XLFDT(DATIM)_"."
|
---|
| 76 | S ^TMP($J,"DG53A564",6,0)=" "
|
---|
| 77 | S ^TMP($J,"DG53A564",7,0)="Post init routine DG53A564 can be deleted."
|
---|
| 78 | I QFLG D
|
---|
| 79 | .S ^TMP($J,"DG53A564",4,0)="YES) was asked to stop on "_$$FMTE^XLFDT(DATIM)_"."
|
---|
| 80 | .S ^TMP($J,"DG53A564",5,0)=" "
|
---|
| 81 | .S ^TMP($J,"DG53A564",6,0)="Use the entry point QUEUE^DG53A564 to resume seeding."
|
---|
| 82 | S XMDUZ="Patch DG*5.3*564A"
|
---|
| 83 | S XMTEXT="^TMP($J,""DG53A564"","
|
---|
| 84 | S XMY(DUZ)=""
|
---|
| 85 | D ^XMD
|
---|
| 86 | K ^TMP($J,"DG53A564")
|
---|
| 87 | S ZTREQ="@"
|
---|
| 88 | Q
|
---|
| 89 | ;
|
---|
| 90 | QUEUE ;Line tag for field to use to requeue seeding
|
---|
| 91 | N X,DG53A564
|
---|
| 92 | S DG53A564=1
|
---|
| 93 | D EN1
|
---|
| 94 | Q
|
---|