source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXICLN1.m@ 1710

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1PXICLN1 ;ISL/dee - Cleanup routine for PX*1.0*1 ;9/3/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1**;Aug 12, 1996
3 ;
4 D PACKAGE
5 D QUE
6 Q
7 ;
8PACKAGE ;Fix the PCE package file entry.
9 N PXPCE,PXPCE,PXPCE22,PXVT,PXVTC,PXVT22,PXFDA,PXERROR
10 S PXPCE=$$PKG2IEN^VSIT("PX")
11 S PXPCEC=PXPCE_","
12 Q:PXPCE'>0
13 S PXVT=$$PKG2IEN^VSIT("VSIT")
14 S PXVTC=PXVT_","
15 D
16 . N DIC,X,Y
17 . S DIC="^DIC(9.4,"_PXPCE_",22,"
18 . S DIC(0)="LX"
19 . S DIC("P")=$P(^DD(9.4,22,0),"^",2)
20 . S DA(1)=PXPCE
21 . S X="1.0"
22 . D ^DIC
23 . S PXPCE22=+Y
24 I $$GET1^DIQ(9.4,PXPCEC,2,"I","","PXERROR")="" D
25 . S PXFDA(9.4,PXPCEC,2)="Patient Care Encounter"
26 I $$GET1^DIQ(9.4,PXPCEC,11.01,"I","","PXERROR")="" D
27 . S PXFDA(9.4,PXPCEC,11.01)="SLC"
28 I $$GET1^DIQ(9.4,PXPCEC,11.3,"I","","PXERROR")="" D
29 . S PXFDA(9.4,PXPCEC,11.3)="I"
30 I $$GET1^DIQ(9.4,PXPCEC,13,"I","","PXERROR")'="1.0" D
31 . S PXFDA(9.4,PXPCEC,13)="1.0"
32 I PXVT>0,$G(PXPCE22)>0 D
33 . D
34 .. N DIC,X,Y
35 .. S DIC="^DIC(9.4,"_PXVT_",22,"
36 .. S DIC(0)="X"
37 .. S DIC("P")=$P(^DD(9.4,22,0),"^",2)
38 .. S DA(1)=PXVT
39 .. S X="2.0"
40 .. D ^DIC
41 .. S PXVT22=+Y
42 . I PXVT22>0 D
43 .. N PXP22,PXV22
44 .. S PXP22=PXPCE22_","_PXPCEC
45 .. S PXV22=PXVT22_","_PXVTC
46 .. I $$GET1^DIQ(9.49,PXP22,1,"I","","PXERROR")="" D
47 ... S X=$$GET1^DIQ(9.49,PXV22,1,"I","","PXERROR")
48 ... I X]"" S PXFDA(9.49,PXP22,1)=X
49 .. I $$GET1^DIQ(9.49,PXP22,2,"I","","PXERROR")="" D
50 ... S X=$$GET1^DIQ(9.49,PXV22,2,"I","","PXERROR")
51 ... I X]"" S PXFDA(9.49,PXP22,2)=X
52 .. I $$GET1^DIQ(9.49,PXP22,3,"I","","PXERROR")="" D
53 ... S X=$$GET1^DIQ(9.49,PXV22,3,"I","","PXERROR")
54 ... I X]"" S PXFDA(9.49,PXP22,3)=X
55 I $D(PXFDA) D FILE^DIE("","PXFDA")
56 Q
57 ;
58QUE ; Queue job to deleting the 800 node on all Stop Code Visits.
59 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
60 D BMES^XPDUTL("Deleting the 800 node on all Stop Code Visits.")
61 S ZTRTN="STOP800^PXICLN1"
62 S ZTIO=""
63 S ZTDESC="PX*1.0*1 tasked cleanup job"
64 S ZTDTH=$H
65 D ^%ZTLOAD
66 I $D(ZTSK) D MES^XPDUTL("The job is task # "_ZTSK)
67 I '$D(ZTSK) D MES^XPDUTL("Could not start the task job.") D BMES^XPDUTL("You should start it by doing: D QUE^PXICLN1 at the programmers prompt.")
68 Q
69 ;
70STOP800 ;Delete the 800 node from all Stop Code visits
71 N PXIVSIT,VSIT
72 S PXIVSIT=0
73 F S PXIVSIT=$O(^AUPNVSIT(PXIVSIT)) Q:'PXIVSIT D
74 . Q:'$D(^AUPNVSIT(PXIVSIT,800))
75 . Q:$P($G(^AUPNVSIT(PXIVSIT,150)),"^",3)'="S"
76 . K VSIT
77 . I $P(^AUPNVSIT(PXIVSIT,800),"^",1)]"" S VSIT("SC")="@"
78 . I $P(^AUPNVSIT(PXIVSIT,800),"^",2)]"" S VSIT("AO")="@"
79 . I $P(^AUPNVSIT(PXIVSIT,800),"^",3)]"" S VSIT("IR")="@"
80 . I $P(^AUPNVSIT(PXIVSIT,800),"^",4)]"" S VSIT("EC")="@"
81 . I $D(VSIT) S VSIT("IEN")=PXIVSIT D UPD^VSIT K ^AUPNVSIT(PXIVSIT,800)
82 ;
83MAIL ;Send mail messge that job is done. Also send to SLC IRMFO.
84 N XMY,XMSUB,PXTEXT,XMTEXT
85 S XMY(DUZ)=""
86 S XMY("G.PCEINSTAL@ISC-SLC.VA.GOV")=""
87 S XMSUB="PX*1.0*1 Cleanup is finished"
88 S PXTEXT(1)="PX*1.0*1 Cleanup job is done."
89 S:$D(ZTQUEUED) PXTEXT(2)="The task job number "_ZTQUEUED_" is finished."
90 S PXTEXT(3)=" "
91 S PXTEXT(4)="The site part if the Visit ID for this site is:"
92 S PXTEXT(5)=" "_$G(^VSIT(150.2,+$P($G(^DIC(150.9,1,4)),"^",2),0))
93 S XMTEXT="PXTEXT("
94 D ^XMD
95 Q
96 ;
Note: See TracBrowser for help on using the repository browser.