source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPNCV3.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.4 KB
RevLine 
[613]1TIUPNCV3 ;SLC/DJP ;PNs ==> TIU cnv rtns ;5-7-97
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3ERRORLOG ;Captures information on records that are NOT converted.
4 S BADREC=1 I '$D(ERRCTR) S ERRCTR=0
5 S ERRCTR=ERRCTR+1 S $P(^TIU(8925.97,1,0),U,7)=ERRCTR
6 S ^GMR(121,"ERROR",GMRPIFN)=PROBLEM
7 Q
8 ;
9TITLE ;Defines variables required for Document Definition look-up
10 ; PNT=^GMR(121.2,TIU("TITLE")),0)
11 ; (1)=TITLE * (2)=TYPE * (3) TYPE NARRATIVE
12 ; (4)=INACTIVE * (5) TIU TITLE IEN
13 S PNT=$G(^GMR(121.2,TIU("TITLE"),0))
14 I PNT="" S PROBLEM="Progress Note - IFN "_GMRPIFN_": TITLE not defined in ^GMR(121.2 - (broken pointer)." D ERRORLOG K PROBLEM Q
15 S PNT(5)=$P($G(^GMR(121.2,TIU("TITLE"),1)),U,3)
16 I PNT(5)'>0 S PROBLEM="Progress Note IFN "_GMRPIFN_": TITLE not defined in ^TIU(8925.1." D ERRORLOG K PROBLEM Q
17 S PNT(1)=$P($G(PNT),U,1),PNT(2)=$P($G(PNT),U,2),PNT(4)=$P($G(PNT),U,4)
18 I PNT(1)=""!PNT(2)="" S PROBLEM="Progress Note - IFN "_GMRPIFN_": Incomplete TITLE information in ^GMR(121.2." D ERRORLOG K PROBLEM Q
19 S X=PNT(2),DIC=121.1,DIC(0)="X,Z" D ^DIC K DIC
20 I +Y<0 S PROBLEM="Progress Note IFN "_GMRPIFN_": TYPE not defined in ^GMR(121.1 (broken pointer)." D ERRORLOG K PROBLEM Q
21 S PNT(3)=$P(Y,U,2)
22 I $P($G(^TIU(8925.1,PNT(5),0)),U,4)'="DOC" S PROBLEM="Progress Note Title: "_PNT(3)_" not defined correctly in ^TIU(8925.1." D ERRORLOG K PROBLEM Q
23 I PNT(4)'="" S TIU(1701)=PNT(1),X=PNT(2) D TITLESET Q
24 D TITLESET
25 Q
26 ;
27TITLESET ;Sets pointers for Document Definition
28 ; .01 DOCUMENT TYPE * .04 PARENT DOCUMENT TYPE
29 ; 1506 COSIGNATURE REQUIRED * 1701 SUBJECT (description)
30 S TIU(.01)=PNT(5),TIUNM=$P(^TIU(8925.1,PNT(5),0),U,1)
31 S TIU(.04)="",TIU(.04)=$O(^TIU(8925.1,"AD",TIU(.01),TIU(.04)))
32 K X,Y,DIC
33 Q
34 ;
35STATUS(TIUSTAT) ;Returns DOCUMENT STATUS pointer
36 N DIC,X,Y
37 I TIU("MHCONV")="Y" S TIUSTAT="COMPLETED"
38 S X=TIUSTAT,DIC="^TIU(8925.6,",DIC(0)="X,Z" D ^DIC Q:+Y<1
39 Q $P(Y,U,1)
40 ;
41DXLS(TIUDX) ;Resolves variable DXLS ptr from Final Discharge Note
42 S P5=""
43 S P1=$P(TIUDX,";",2) ; Global reference
44 S P2=$P(TIUDX,";",1) ; IEN
45 S P3="^"_P1_P2_","_0_")" ;^(0) reference
46 S P4="^"_P1_P2_",""D"")" ;^("D") reference
47 I P1["ICD9" D Q P5
48 .S P5=$P(@P3,U,3)_" ("_$P(@P3,U)_")"
49 .I P1["YSD" D Q P5
50 ..S P4=$G(@P4) Q:P4']""
51 ..S P5=P4
52 ..S P3=$P($G(@P3),U)
53 ..S:P3]"" P5=P5_" ("_P3_")"
54 .I P1["DIC" D
55 ..S P5=$P(@P3,U)_" ("_$P(@P3,U,2)_")"
56 Q P5
57 ;
58BEDSEC(TIUBS) ;Resolves D/C Bedsection ptr from the Final Discharge Note
59 N Y
60 S Y=$P(^DIC(42,TIUBS,0),U,1)
61 Q Y
62 ;
63ROLLEM ;Rolls back ^GMR(121 entries in ^TIU(8925
64 K DIR W @IOF W !!?16,"****** ROLL BACK ******"
65 W !!?5,"This option will delete all progress notes entered"
66 W !?5,"into ^TIU(8925 from the GMRPN/TIU Conversion. The"
67 W !?5,"option uses ^DIK to roll back the file. Run time is"
68 W !?5,"dependent upon the number of entries made during the"
69 W !?5,"conversion."
70 W !! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="YES"
71 S DIR("?")="^D HELP10^TIUPNCV3" D ^DIR I $D(DIRUT)!(Y=0) Q
72 W !!?5,"BEGINNING ROLL BACK...",!
73 S TST=$P($G(^TIU(8925.97,1,2)),U,1),LST=$P($G(^TIU(8925.97,1,2)),U,2)
74 S DIK="^TIU(8925,"
75 Q:TST!LST=""
76 F DA=TST:1:LST D:$P($G(^TIU(8925,DA,13)),U,3)="C" ^DIK
77 W !!,"ROLLBACK COMPLETED",!
78 K TST,DIK,LST,DA,TIUDIV
79 Q
80 ;
81HELP10 ;Help text for ROLLBACK prompt
82 W !!?5,"Press <ret> to continue with roll back of Progress Notes"
83 W !?5,"entered during the conversion. The rollback will begin and"
84 W !?5,"based on rollback fields in ^TIU(8925.97, TIU Conversions."
85 W !!?5,"Enter NO or ""^"" to stop this option."
86 Q
87 ;
Note: See TracBrowser for help on using the repository browser.