source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPNCVX.m@ 1361

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1TIUPNCVX ;SF/JLI ;PNs ==> TIU cnv rtns ;5-7-97
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3 ;
4 ;set x-refs for conversion
5ENTRY ;
6 S DA=TIUIFN,TIU0=$G(^TIU(8925,TIUIFN,0)),TIU13=$G(^(13))
7 S TIU12=$G(^(12)),TIU15=$G(^(15))
8 S TIURDATE=9999999-TIU13
9 S ^TIU(8925,"B",$P(TIU0,U),DA)=""
10 I +TIU13 D
11 . I +$P(TIU0,U,5) D
12 . . S ^TIU(8925,"ALL","ANY",+TIU0,+$P(TIU0,U,5),TIURDATE,DA)=""
13 . . I +$P(TIU0,U,2) S ^TIU(8925,"APT",+$P(TIU0,U,2),+TIU0,+$P(TIU0,U,5),TIURDATE,DA)=""
14 . . I +$P(TIU0,U,3) S ^TIU(8925,"AVSIT",+$P(TIU0,U,3),+TIU0,+$P(TIU0,U,5),TIURDATE,DA)=""
15 . . I +$P(TIU12,U,2) S ^TIU(8925,"AAU",+$P(TIU12,U,2),+TIU0,+$P(TIU0,U,5),TIURDATE,DA)=""
16 . . I +$P(TIU12,U,5) S ^TIU(8925,"ALOC",+$P(TIU12,U,5),+TIU0,+$P(TIU0,U,5),TIURDATE,DA)=""
17 . . I +$P(TIU12,U,8) S ^TIU(8925,"ASUP",+$P(TIU12,U,8),+TIU0,+$P(TIU0,U,5),TIURDATE,DA)=""
18 . . I +$P(TIU13,U,2) S ^TIU(8925,"ATC",+$P(TIU13,U,2),+TIU0,+$P(TIU0,U,5),TIURDATE,DA)=""
19 . . I +$O(^TIU(8925.9,"B",DA,0)) D APRBS^TIUDD(+TIU0,+$P(TIU0,U,5),TIURDATE,DA)
20 . I +$P(TIU0,U,2) S ^TIU(8925,"APTCL",+$P(TIU0,U,2),+$$CLINDOC^TIULC1(+TIU0,DA),TIURDATE,DA)=""
21 . I +$P(TIU0,U,2) S ^TIU(8925,"APTCL",+$P(TIU0,U,2),38,TIURDATE,DA)=""
22 I $P($$DOCTYPE^TIULF(DA),U)="DOC",+$P(TIU0,U,2),+$P(TIU0,U,3) D
23 . S ^TIU(8925,"AV",+$P(TIU0,U,2),+TIU0,+$P(TIU0,U,3),DA)=""
24 . S ^TIU(8925,"AA",+$P(TIU0,U,2),+TIU0,(9999999-$P(+^AUPNVSIT(+$P(TIU0,U,3),0),".")),DA)=""
25 . S ^TIU(8925,"AE",+$P(TIU0,U,2),(9999999-$P(+^AUPNVSIT(+$P(TIU0,U,3),0),".")),+TIU0,DA)=""
26 ;
27 I $P(TIU0,U,2)'="" D
28 . S ^TIU(8925,"C",$P(TIU0,U,2),DA)=""
29 . I +$$APTP^TIULX(DA),+TIU15 S ^TIU(8925,"APTP",+$P(TIU0,U,2),+TIU15,DA)=""
30 . I +$P(TIU0,U,4),+TIU13,+$P(TIU0,U,5) S ^TIU(8925,"ADCPT",+$P(TIU0,U,2),+$P(TIU0,U,4),+$P(TIU0,U,5),TIURDATE,DA)=""
31 ;
32 I $P(TIU0,U,3)'="" D
33 . S X=$P(TIU0,U,3)
34 . D:$D(^AUPNVSIT(+$P(TIU0,U,3))) ADD^AUPNVSIT
35 . S ^TIU(8925,"V",$P(TIU0,U,3),DA)=""
36 . X ^DD(8925,.03,1,7,1) ; TRIGGER
37 . S DA=TIUIFN
38 I $P(TIU0,U,6)'="" S ^TIU(8925,"DAD",$P(TIU0,U,6),DA)=""
39 I $P(TIU0,U,12)'="" S ^TIU(8925,"FIX",$P(TIU0,U,12),DA)=""
40 I $P(TIU12,U)'="" S ^TIU(8925,"F",$P(TIU12,U),DA)=""
41 I $P(TIU12,U,2)'="" D
42 . S ^TIU(8925,"CA",$P(TIU12,U,2),DA)=""
43 . I +$$AAUP^TIULX(DA),+TIU15 S ^TIU(8925,"AAUP",+$P(TIU12,U,2),+TIU15,DA)=""
44 I $P(TIU12,U,5)'="",+$$ALOCP^TIULX(DA),+TIU15 S ^TIU(8925,"ALOCP",+$P(TIU12,U,5),+TIU15,DA)=""
45 I $P(TIU12,U,8)'="" S ^TIU(8925,"CS",$P(TIU12,U,8),DA)=""
46 I $P(TIU13,U)'="" S ^TIU(8925,"D",$P(TIU13,U),DA)=""
47 I $P(TIU13,U,2)'="" S ^TIU(8925,"TC",$P(TIU13,U,2),DA)=""
48 I $P(TIU13,U,4)'="" S ^TIU(8925,"E",$P(TIU13,U,4),DA)=""
49 S X=$P($G(^TIU(8925,DA,150)),U)
50 I X'="" S ^TIU(8925,"VID",$E(X,1,30),DA)=""
51 I +TIU0'=81 D SACLPT^TIUDD0(.02,$P(TIU0,U,2))
52 I $P(TIU15,U)'>0 D SACLAU^TIUDD0(1202,$P(TIU12,U,2)),SACLAU1^TIUDD0(1302,$P(TIU13,U,2))
53 I '$P(TIU15,U,7),($P(TIU0,U,5)<7) D
54 . I $P(TIU0,U,5)=6 D SACLEC^TIUDD0(1208,$P(TIU12,U,8)) I 1
55 . E I $P(TIU0,U,5)>4 D SACLEC^TIUDD0(1208,$P(TIU12,U,8))
56 I +TIU0'=81,$P(TIU15,U,2)>0 D SACLSB^TIUDD0(1502,$P(TIU15,U,2))
57 I $P(TIU0,U,7)'>0 S $P(^(0),U,7)=+$G(^TIU(8925,DA,13))
58 I $P(TIU12,U,5)'>0 S VTYPE="E"
59 E S VLOC=+$P(TIU12,U,5),STOP=+$P(^SC(VLOC,0),U,7) D
60 . I STOP>0 S STOP=$P(^DIC(40.7,STOP,0),U) S VTYPE=$S(STOP["TELE":"T",1:"A") I 1
61 . E D
62 . . I $P(^SC(VLOC,0),U,3)="W" S VTYPE="H"
63 . . E S VTYPE="E"
64 . S $P(^TIU(8925,DA,0),U,13)=VTYPE
65 D SAPTLD^TIUDD0(.02,$P(TIU0,U,2))
66 Q
Note: See TracBrowser for help on using the repository browser.