source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTSU.m@ 975

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1GMRCSTSU ;SLC/DLT - Change status based on current order status ;7/16/98 03:43
2 ;;3.0;CONSULT/REQUEST TRACKING;**4**;DEC 27, 1997
3CPRSUPD(GMRCO) ;Update CPRS order with new status
4 ;GMRCO=IEN from file 123
5 Q
6 N DFN,CTRLCODE,GMRCSTS,GMRCPROV,GMRCORFN,ORSTS,ORIFN
7 S GMRCSTS=$P(^GMR(123,+GMRCO,0),"^",12),GMRCORFN=$P(^(0),"^",3),DFN=$P(^(0),"^",2),GMRCPROV=$P(^(0),"^",14)
8 ;S CTRLCODE=$S(GMRCSTS=5:"ZU",GMRCSTS=6:"ZU",1:"ZR")
9 ;S DIE="^GMR(123,",DA=GMRCO,DR=".03////^S X=""@"""
10 ;D ^DIE
11 K GMRCSTS,DIE,DA,DR
12 Q
13 ;D EN^GMRCHL7(DFN,+GMRCO,"","",CTRLCODE,GMRCPROV,"","") ;Send CPRS an HL-7 message about status of purge - can/can't purge record
14 Q
15END Q
16END1 K DA,GMRCDT,GMRCPCNT,GMRCIDT,GMRCTRLC,GMRCOM
17 K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
18 Q
19 ;
20TIURSL ;Get TIU results to update the Consults package
21 ;One time run to get the information TIU has into the consults package.
22 ;
23 F PASS=1,2 D LOOP
24 Q
25 ;
26LOOP ;LOOP Thru TIU entries to populate the 50th node.
27 S TIUDA=0,TIUEDT=2980500,GMRCY=0
28 F S TIUEDT=$O(^TIU(8925,"F",TIUEDT)) Q:'TIUEDT D
29 . S TIUDA=$O(^TIU(8925,"F",TIUEDT,"")) Q:'TIUDA
30 . Q:'$D(^TIU(8925,TIUDA,14))
31 . S GMRCO=$P($G(^TIU(8925,TIUDA,14)),"^",5)
32 . Q:$P(GMRCO,";",2)'="GMR(123,"
33 . Q:'$D(^GMR(123,+GMRCO,0))
34 . I PASS=1 K ^GMR(123,+GMRCO,50) Q
35 . ;PASS 2 ADD
36 . S GMRCVDA=TIUDA_";TIU(8925,"
37 . D ADDRSLT^GMRCTIUA(+GMRCO,GMRCVDA)
38 Q
39 ;
40ONETIME ;One time run to load the file 123 consult entry multiple results
41 ;with the TIU Narrative Result
42 ;
43 N ZTSK
44 S ZTSK=$$QUEUE("ONETIMER^GMRCSTSU","One time run to load the file 123 consult entry multiple results and rebuild cross-references")
45 I ZTSK W !,"One time load Queued to run. Task#",ZTSK
46 E W !,"One Time load failed to queue."
47 Q
48 ;
49ONETIMER ;
50 D XREF
51 D NWXREF
52 S GMRCDT=2970100,GMRCY=0
53 F S GMRCDT=$O(^GMR(123,"B",GMRCDT)) Q:'GMRCDT D
54 . S GMRCO=0 F S GMRCO=$O(^GMR(123,"B",GMRCDT,GMRCO)) Q:'GMRCO D
55 .. I '$D(^GMR(123,+GMRCO,50)),+$P($G(^GMR(123,+GMRCO,0)),"^",20) S GMRCY=$$LOAD^GMRCTIUA(GMRCO)
56 ;
57 Q
58XREF ;re-create cross references for specific fields in files
59 N SVC
60 D BMES^XPDUTL("Re-indexing APC cross reference for service entries ")
61 K ^GMR(123.5,"APC")
62 S SVC=0
63 F S SVC=$O(^GMR(123.5,SVC)) Q:'SVC D
64 . S DA(1)=SVC
65 . S DIK="^GMR(123.5,"_DA(1)_",10,"
66 . S DIK(1)=".01^APC"
67 . D ENALL^DIK
68 D BMES^XPDUTL("Re-indexing AC cross reference for sub-service entries ")
69 S SVC=0
70 F S SVC=$O(^GMR(123.5,SVC)) Q:'SVC D
71 . K ^GMR(123.5,SVC,10,"AC")
72 . S DA(1)=SVC
73 . S DIK="^GMR(123.5,"_DA(1)_",10,"
74 . S DIK(1)=".01^AC"
75 . D ENALL^DIK
76 Q
77 ;
78 ;
79NWXREF ;Create new cross references for specific fields in file 123
80 N DIK
81 D BMES^XPDUTL("Creating new G cross-reference on Sending Provider for consults in 123 ...")
82 S DIK="^GMR(123,"
83 S DIK(1)="10^G"
84 D ENALL^DIK
85 ;
86 D BMES^XPDUTL("Creating new H cross-reference on FROM location for consults in 123 ...")
87 S DIK="^GMR(123,"
88 S DIK(1)="2^H"
89 D ENALL^DIK
90 ;
91 D BMES^XPDUTL("Creating new R cross-reference on consult results in file 123 ...")
92 N GMRCO,DIK,DA
93 S GMRCO=0
94 F S GMRCO=$O(^GMR(123,GMRCO)) Q:'GMRCO D
95 . S DA(1)=GMRCO
96 . S DIK="^GMR(123,"_DA(1)_",50,"
97 . S DIK(1)=".01^R"
98 . D ENALL^DIK
99 Q
100 ;
101QUEUE(ZTRTN,ZTDESC,ZTDTH,ZTIO) ;
102 ;
103 ; ZTRTN -- ROUTINE TO RUN (MANDATORY)
104 ; ZTDESC - DESCRIPTION OF THE TASK (OPTIONAL)
105 ; ZTDTH -- TIME TO RUN (OPTIONAL - DEFAULT = NOW)
106 ; ZTIO --- DEVICE TO SEND OUTPUT TO (OPTIONAL)
107 ;
108 N ZTCPU,ZTPAR,ZTPRE,ZTPRI
109 N ZTSAVE,ZTSK,ZTUCI
110 ;
111 Q:'$L($G(ZTRTN)) 0
112 S:'$L($G(ZTDESC)) ZTDESC="CONSULT/REQUEST PACKAGE TASK"
113 S:'$L($G(ZTIO)) ZTIO=""
114 S:'$L($G(ZTDTH)) ZTDTH=$H
115 D ^%ZTLOAD
116 ;
117 Q $G(ZTSK)
118 ;
Note: See TracBrowser for help on using the repository browser.