source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIU199.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.6 KB
Line 
1TIU199 ;BP/JML - TIU Alert Fix Tool ; 7/6/05 4:06pm
2 ;;1.0;TEXT INTEGRATION UTILITIES;**199**;Jun 20, 1997
3 ;
4 Q
5TRIGGER ; trigger code for the .05 field of file 8925.7
6 ; note - do not "NEW" DA or X as these are passed in from FileMan
7 N TIU0,TIUSET,TIUDOC,TIUEXP,FDA
8 S TIUEXP=$P($G(^TIU(8925.7,DA,0)),"^",3),TIUSET=0
9 I $$ISSURFOR^TIUADSIG(X,TIUEXP) S TIUSET=1
10 S FDA(8925.7,DA_",",.09)=TIUSET
11 D FILE^DIE("","FDA","TIUERR")
12 Q
13 ;
14EN ; MAIN DRIVER
15 N DIC,TIUPERS,TIUDTS,TIUCSTAT,TIUQ,DTOUT,DUOUT,Y,TIUNAME
16 D CLEAR^VALM1
17 S DIC="^VA(200,",DIC(0)="AEMQ"
18 S DIC("A")="Select ADDITIONAL SIGNER: "
19 D ^DIC S TIUPERS=+Y,TIUNAME=$P(Y,"^",2)
20 Q:$G(DTOUT)!($G(DUOUT))!(Y=-1)
21 D DTRANGE^TIUADCL(.TIUDTS)
22 Q:'$G(TIUDTS("BEGDT"))!('$G(TIUDTS("ENDDT")))
23 S TIUCSTAT=$O(^TIU(8925.6,"B","COMPLETED",""))
24 D GATHER
25 S TIUQ=0
26LOOP ;
27 I '$D(^TMP($J)) S TIUQ=$$NODATA()
28 I $D(^TMP($J)) D
29 .D PRINT
30 .S TIUQ=$$PROMPT()
31 ; TIUQ: 0=LOOP ON EXISTING BUILD, 2=CREATE NEW SEARCH/BUILD, 1=QUIT ENTIRELY
32 I TIUQ=0 G LOOP
33 I TIUQ=2 G EN
34 K ^TMP($J)
35 Q
36 ;
37GATHER ; COLLECT DATA BASED ON SEARCH CRITERIA
38 N TIUNOTE,TIUCNT,TIUADD,TIUAIEN,TIUA0,TIU0,TIUSTAT,TIU13,TIURFDT,TIUDTYP,TIUDFN,TIUPAT
39 K ^TMP($J)
40 S TIUNOTE="",TIUCNT=1
41 F S TIUNOTE=$O(^TIU(8925.7,"AE",TIUNOTE)) Q:TIUNOTE="" D
42 .S TIUADD=""
43 .F S TIUADD=$O(^TIU(8925.7,"AE",TIUNOTE,TIUADD)) Q:TIUADD="" D
44 ..Q:TIUPERS'=TIUADD
45 ..S TIUAIEN=""
46 ..F S TIUAIEN=$O(^TIU(8925.7,"AE",TIUNOTE,TIUADD,TIUAIEN)) Q:TIUAIEN="" D
47 ...S TIUA0=$G(^TIU(8925.7,TIUAIEN,0))
48 ...Q:$P(TIUA0,"^",5)="" ; QUIT IF NOT SIGNED AT ALL
49 ...Q:$P(TIUA0,"^",3)=$P(TIUA0,"^",5) ; QUIT IF EXPECTED AND ACTUAL ARE SAME
50 ...Q:+$P(TIUA0,"^",9)=1 ; QUIT IF ALRADY MARKED AS 'SIGNED BY SURROGATE'
51 ...S TIU0=$G(^TIU(8925,TIUNOTE,0))
52 ...S TIUSTAT=$P(TIU0,"^",5)
53 ...Q:TIUSTAT'=TIUCSTAT ; QUIT IF NOT IN COMPLETED STATUS
54 ...S TIU13=$G(^TIU(8925,TIUNOTE,13))
55 ...S TIURFDT=$P($P(TIU13,"^"),".")
56 ...Q:TIURFDT<TIUDTS("BEGDT")!(TIURFDT>TIUDTS("ENDDT")) ; QUIT IF NOT IN DT RANGE
57 ...S TIUDTYP=$P(TIU0,"^"),TIUDFN=$P(TIU0,"^",2)
58 ...S TIUPAT=$$GETPAT(TIUDFN)
59 ...S ^TMP($J,TIUCNT)=TIUAIEN_"^"_TIUPAT_"^"_TIUDTYP_"^"_TIURFDT
60 ...S TIUCNT=TIUCNT+1
61 Q
62 ;
63PRINT ;
64 N TIUCNT,TIUDATA,TIUTYP,TIURFDT
65 D HEAD
66 S TIUCNT=""
67 F S TIUCNT=$O(^TMP($J,TIUCNT)) Q:TIUCNT="" D
68 .S TIUDATA=^TMP($J,TIUCNT)
69 .S TIUTYP=$P($G(^TIU(8925.1,$P(TIUDATA,"^",4),0)),"^")
70 .S Y=$P(TIUDATA,"^",5) D DD^%DT S TIURFDT=Y
71 .W !,TIUCNT,?5,$E($P(TIUDATA,"^",2),1,15),?22,"("_$P(TIUDATA,"^",3)_")",?31,$E(TIUTYP,1,25),?58,TIURFDT
72 Q
73 ;
74PROMPT() ; PROMPT BASED ON DATA IN ^TMP($J) - QUIT VALUE DETERMINES FLOW IN LOOP/EN LINE TAGS
75 N X,TIUAIEN,DIR,DIRUT,FDA
76 W !
77 S DIR("A")="'NEW' FOR A NEW SEARCH OR '^' TO QUIT"
78 S DIR("A",1)="ENTER SEQUENCE # TO MARK AS 'SIGNED BY SURROGATE',"
79 S DIR(0)="F"
80 D ^DIR
81 ; QUIT CONDITIONS
82 I $G(DIRUT) Q 1
83 I X="NEW" Q 2
84 I '$D(^TMP($J,X)) D Q 0
85 .W !!,"INVALID CHOICE" D CLEAR^VALM1
86 ; CHANGE VALUES AND KILL TMP
87 S TIUAIEN=+^TMP($J,X)
88 S FDA(8925.7,TIUAIEN_",",.09)=1
89 D FILE^DIE("","FDA","TIUERR")
90 K ^TMP($J,X)
91 I '$D(^TMP($J)) Q 2
92 Q 0
93 ;
94HEAD ;
95 D CLEAR^VALM1
96 W "ADDITIONAL SIGNER: ",TIUNAME,!!
97 W !,"SEQ",?5,"PATIENT",?31,"DOCUMENT TYPE",?58,"REFERENCE DATE"
98 W !,"---",?5,"-------",?31,"-------------",?58,"--------------"
99 Q
100 ;
101NODATA() ;
102 D CLEAR^VALM1
103 W !!,?15,"NO DATA TO REPORT FOR THIS SEARCH"
104 N DIRUT,TIUND S TIUND=2
105 D PAUSE^VALM1
106 I $G(DIRUT) S TIUND=1
107 Q TIUND
108 ;
109GETPAT(TIUDFN) ;
110 N DFN,TIUSSN,TIUPN,VADM
111 S DFN=TIUDFN
112 D DEM^VADPT
113 S TIUSSN=$P(VADM(2),"^")
114 S TIUPN=VADM(1)_"^"_$E(VADM(1))_$E(TIUSSN,6,$L(TIUSSN))
115 Q TIUPN
116 ;
117POST199 ; REINDEX THE ABBREVIATION FIELD OF FILE 8925.1
118 N DIK
119 S DIK="^TIU(8925.1,",DIK(1)=".02"
120 D ENALL^DIK
121 Q
Note: See TracBrowser for help on using the repository browser.