source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUEDS1.m@ 1261

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

revised back to 6/30/08 version
File size: 1.8 KB
RevLine 
[623]1TIUEDS1 ; ;03/29/06
[613]2 S X=DG(DQ),DIC=DIE
[623]3 I $P($$DOCTYPE^TIULF(+DA),U)="DOC",$L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) S ^TIU(8925,"AA",+X,+^TIU(8925,+DA,0),(9999999-$P(+^AUPNVSIT($P(^TIU(8925,+DA,0),U,3),0),".")),+DA)=""
[613]4 S X=DG(DQ),DIC=DIE
[623]5 I +$P($G(^TIU(8925,+DA,0)),U),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"APT",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)=""
[613]6 S X=DG(DQ),DIC=DIE
[623]7 I $P($$DOCTYPE^TIULF(+DA),U)="DOC",$L($P(^TIU(8925,+DA,0),U)),(+$P(^(0),U,3)>0) S ^TIU(8925,"AE",+X,(9999999-$P(+^AUPNVSIT($P(^TIU(8925,+DA,0),U,3),0),".")),+^TIU(8925,+DA,0),+DA)=""
[613]8 S X=DG(DQ),DIC=DIE
[623]9 S ^TIU(8925,"C",$E(X,1,30),DA)=""
[613]10 S X=DG(DQ),DIC=DIE
[623]11 I $P($$DOCTYPE^TIULF(+DA),U)="DOC",+$P($G(^TIU(8925,+DA,0)),U),+$P($G(^(0)),U,3) S ^TIU(8925,"AV",+X,+$P(^TIU(8925,+DA,0),U),+$P(^TIU(8925,+DA,0),U,3),+DA)=""
[613]12 S X=DG(DQ),DIC=DIE
[623]13 I +$$APTP^TIULX(+DA),+$P($G(^TIU(8925,+DA,15)),U) S ^TIU(8925,"APTP",+X,+$P($G(^TIU(8925,+DA,15)),U),+DA)=""
[613]14 S X=DG(DQ),DIC=DIE
[623]15 I +$P($G(^TIU(8925,+DA,0)),U,4),+$P($G(^TIU(8925,+DA,13)),U),+$P($G(^TIU(8925,+DA,0)),U,5) S ^TIU(8925,"ADCPT",+X,+$P(^TIU(8925,+DA,0),U,4),+$P(^TIU(8925,+DA,0),U,5),(9999999-$P(^TIU(8925,+DA,13),U)),DA)=""
[613]16 S X=DG(DQ),DIC=DIE
[623]17 I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,13)),U) S ^TIU(8925,"APTCL",+X,+$$CLINDOC^TIULC1(+$P(^TIU(8925,+DA,0),U),+DA),(9999999-$P(^TIU(8925,+DA,13),U)),DA)=""
18 S X=DG(DQ),DIC=DIE
19 I +$P(^TIU(8925,+DA,0),U),+$P($G(^TIU(8925,+DA,13)),U) S ^TIU(8925,"APTCL",+X,38,(9999999-$P(^TIU(8925,+DA,13),U)),DA)=""
20 S X=DG(DQ),DIC=DIE
21 D SACLPT^TIUDD0(.02,X)
22 S X=DG(DQ),DIC=DIE
23 D SACLAU^TIUDD0(.02,X),SACLAU1^TIUDD0(.02,X)
24 S X=DG(DQ),DIC=DIE
25 D SACLEC^TIUDD0(.02,X)
26 S X=DG(DQ),DIC=DIE
27 D SACLSB^TIUDD0(.02,X)
28 S X=DG(DQ),DIC=DIE
29 D SAPTLD^TIUDD0(.02,X)
Note: See TracBrowser for help on using the repository browser.