source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS96.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1TIUPS96 ; SLC/JER - Post-Install for TIU*1*96 ; 3-MAY-2001 11:21
2 ;;1.0;TEXT INTEGRATION UTILITIES;**96**;Jun 20, 1997'
3MAIN ; Control unit
4 I +$O(^GMR(121,0)),'$D(^XTMP("TIUFIXCS","T1")) D FIXCS
5 I +$G(XPDQUES("POS001")) D DELPNDB
6 I +$G(XPDQUES("POS002")) D DELDSDB
7 D DELFUNC
8 Q
9 ;
10FIXCS ; -- Find/fix Cosigner's Comments
11 N GMRDA,XPDIDTOT S GMRDA=+$G(^XTMP("TIUFIXCS","CHKPT"))
12 D BMES^XPDUTL("** FIND CONVERTED NOTES WITH COSIGNER'S COMMENTS **")
13 S XPDIDTOT=+$P($G(^GMR(121,0)),U,4),XPDIDVT=$G(XPDIDVT,0)
14 D UPDATE^XPDID(0)
15 ; Initialize ^XTMP("TIUFIXCS"
16 S ^XTMP("TIUFIXCS",0)=$$FMADD^XLFDT(DT,90)_U_DT
17 S ^XTMP("TIUFIXCS","T0")=$$NOW^XLFDT
18 F S GMRDA=$O(^GMR(121,GMRDA)) Q:+GMRDA'>0 D
19 . N GMRLI,GMRLINE,TIUDA,TIULI S GMRLI=0
20 . F S GMRLI=+$O(^GMR(121,GMRDA,8,GMRLI)) Q:GMRLI'>0!($G(GMRLINE)]"") D
21 . . N GMRLN
22 . . S GMRLINE=$G(^GMR(121,GMRDA,8,GMRLI,0))
23 . . S GMRLN=$$STRIP^TIULS(GMRLINE)
24 . . I GMRLN']"" S GMRLINE=""
25 . Q:$G(GMRLINE)']""
26 . S TIUDA=+$G(^GMR(121,"CNV",GMRDA)) Q:TIUDA'>0
27 . S TIULI=$$FIND(TIUDA,GMRLINE) Q:+TIULI'>0
28 . D INSERT(TIUDA,TIULI),REGISTER(TIUDA,GMRDA)
29 S ^XTMP("TIUFIXCS","T1")=$$NOW^XLFDT
30 Q
31 ;
32FIND(TIUDA,GMRLINE) ; -- Locate the Cosigner's Comments in converted note
33 N TIULI,TIUHIT S (TIUHIT,TIULI)=0
34 F S TIULI=$O(^TIU(8925,TIUDA,"TEXT",TIULI)) Q:+TIULI'>0 D Q:+TIUHIT
35 . I $G(^TIU(8925,TIUDA,"TEXT",TIULI,0))=GMRLINE S TIUHIT=1
36 Q TIULI
37 ;
38INSERT(TIUDA,TIULI) ; -- Insert the tag for the Cosigner's Comment
39 N TIULJ,TIUSBLK S TIULJ=""
40 ; First, preserve the /es/-blocks
41 D ESGET(TIUDA,.TIUSBLK)
42 ; Next, move the cosigner's comments out of the way
43 F S TIULJ=$O(^TIU(8925,TIUDA,"TEXT",TIULJ),-1) Q:+TIULJ'>0!(TIULJ<TIULI) D
44 . N TIULINE S TIULINE=$G(^TIU(8925,TIUDA,"TEXT",TIULJ,0))
45 . S ^TIU(8925,TIUDA,"TEXT",TIULJ+3,0)=TIULINE
46 ; Now insert the COSIGNER'S COMMENT: tag
47 S ^TIU(8925,TIUDA,"TEXT",TIULI,0)=" "
48 S ^TIU(8925,TIUDA,"TEXT",TIULI+1,0)="COSIGNER'S COMMENT:"
49 S ^TIU(8925,TIUDA,"TEXT",TIULI+2,0)="==================="
50 ; Reset the root of the "TEXT" node
51 D SETXT0(TIUDA)
52 ; Finally, re-file the /es/-blocks
53 D ESPUT(TIUDA,.TIUSBLK)
54 Q
55 ;
56REGISTER(TIUDA,GMRDA) ; -- Register activity in the ^XTMP("TIUFIXCS", array
57 N TIUCNT
58 S (TIUCNT,^XTMP("TIUFIXCS","COUNT"))=+$G(^XTMP("TIUFIXCS","COUNT"))+1
59 S ^XTMP("TIUFIXCS","CHKPT")=GMRDA
60 S ^XTMP("TIUFIXCS","GMR->TIU",GMRDA)=TIUDA
61 D UPDATE^XPDID(TIUCNT)
62 Q
63 ;
64ESGET(TIUDA,TIUSBLK) ; Get the decrypted /es/-blocks
65 N TIUD15,TIUCHK
66 S TIUD15=$G(^TIU(8925,TIUDA,15))
67 S TIUCHK=$$CHKSUM^TIULC("^TIU(8925,"_TIUDA_",""TEXT"")")
68 I $L($P(TIUD15,U,3)) D
69 . S $P(TIUSBLK(1),U,1)=$$DECRYPT^TIULC1($P(TIUD15,U,3),1,TIUCHK)
70 . S $P(TIUSBLK(1),U,2)=$$DECRYPT^TIULC1($P(TIUD15,U,4),1,TIUCHK)
71 I $L($P(TIUD15,U,9)) D
72 . S $P(TIUSBLK(2),U,1)=$$DECRYPT^TIULC1($P(TIUD15,U,9),1,TIUCHK)
73 . S $P(TIUSBLK(2),U,2)=$$DECRYPT^TIULC1($P(TIUD15,U,10),1,TIUCHK)
74 Q
75 ;
76SETXT0(TIUDA) ; Set the root node of the "TEXT" WP-field
77 N TIUC,TIUI S (TIUC,TIUI)=0
78 F S TIUI=$O(^TIU(8925,TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
79 . S:$D(^TIU(8925,TIUDA,"TEXT",TIUI,0)) TIUC=TIUC+1
80 S ^TIU(8925,TIUDA,"TEXT",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
81 Q
82 ;
83ESPUT(DA,TIUSBLK) ; Re-file the /es/-blocks
84 N DIE,DR
85 S DIE=8925
86 ; If the author's signature block exists, file it
87 I $D(TIUSBLK(1)) D
88 . S DR="1503///^S X=$P(TIUSBLK(1),U);1504///^S X=$P(TIUSBLK(1),U,2)"
89 . D ^DIE
90 ; If the cosigner's signature block exists, file it
91 I $D(TIUSBLK(2)) D
92 . S DR="1509///^S X=$P(TIUSBLK(2),U);1510///^S X=$P(TIUSBLK(2),U,2)"
93 . D ^DIE
94 Q
95 ;
96DELPNDB ; -- Remove Progress Notes Globals, DD's, and File of File Entries
97 N TIUS1,TIUCNT,XPDIDTOT S TIUCNT=0,XPDIDVT=+$G(XPDIDVT)
98 D BMES^XPDUTL("** REMOVING PROGRESS NOTES v2.5 DB & DD's **")
99 S XPDIDTOT=5 D UPDATE^XPDID(0)
100 F TIUS1=121,121.1,121.2,121.3,121.99 D
101 . N DIU
102 . S DIU="^GMR("_TIUS1_",",DIU(0)="D" D EN^DIU2
103 . S TIUCNT=TIUCNT+1 D UPDATE^XPDID(TIUCNT)
104 Q
105 ;
106DELDSDB ; -- Remove Discharge Summary Globals, DD's, and File of File Entries
107 N TIUS1,TIUCNT,XPDIDTOT S TIUCNT=0,XPDIDVT=+$G(XPDIDVT)
108 D BMES^XPDUTL("** REMOVING DISCHARGE SUMMARY v1.0 DB & DD's **")
109 S XPDIDTOT=6 D UPDATE^XPDID(0)
110 F TIUS1=128,128.1,128.2,128.3,128.4,128.99 D
111 . N DIU
112 . S DIU="^GMR("_TIUS1_",",DIU(0)="D" D EN^DIU2
113 . S TIUCNT=TIUCNT+1 D UPDATE^XPDID(TIUCNT)
114 Q
115DELFUNC ; -- Remove Discharge Summary FileMan Functions
116 N TIUS1,TIUCNT,XPDIDTOT S TIUCNT=0,XPDIDVT=+$G(XPDIDVT)
117 D BMES^XPDUTL("** REMOVING DISCHARGE SUMMARY v1.0 FILEMAN FUNCTIONS **")
118 D MES^XPDUTL(" ")
119 S XPDIDTOT=3 D UPDATE^XPDID(0)
120 F TIUS1="GMRD ISADDENDUM","GMRD NAME FORMAT","GMRD TREAT SPEC NAME" D
121 . N DIC,X,Y,DIK,DA,DIDEL
122 . S DIC=.5,DIC(0)="X",X=TIUS1 D ^DIC Q:+Y'>0
123 . D MES^XPDUTL("Deleting: "_$P(Y,U,2))
124 . S (DIDEL,DIK)=DIC,DA=+Y D ^DIK
125 . S TIUCNT=TIUCNT+1 D UPDATE^XPDID(TIUCNT)
126 Q
Note: See TracBrowser for help on using the repository browser.