source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUDSCN1.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: 3.6 KB
Line 
1TIUDSCN1 ; SLC/JER - Discharge Summary Conversion routine
2 ;;1.0;TEXT INTEGRATION UTILITIES;**9**;Jun 20, 1997
3STUFREC(DA,PARENT,GMRD0,GMRDACT) ; Stuff fixed field data
4 N FDA,FDARR,IENS,FLAGS,TIUMSG
5 S IENS=""""_DA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
6 S @FDARR@(.02)=$G(DFN),@FDARR@(.03)=$P($G(TIU("VISIT")),U)
7 S @FDARR@(.07)=$P(TIU("EDT"),U),@FDARR@(.08)=$P(TIU("LDT"),U)
8 S @FDARR@(.09)=$P(GMRD0,U,9),@FDARR@(.1)=$P(GMRD0,U,10)
9 S @FDARR@(.13)="H"
10 S @FDARR@(1201)=$P(GMRDACT,U,6),@FDARR@(1202)=$P(GMRDACT,U)
11 S @FDARR@(1205)=$P($G(TIU("LOC")),U),@FDARR@(1211)=$P($G(TIU("VLOC")),U)
12 S (@FDARR@(1208),@FDARR@(1209))=$P(GMRDACT,U,9)
13 S @FDARR@(1301)=$S(+$P(GMRD0,U,8)>0:$P(GMRD0,U,8),1:$P(GMRDACT,U,3))
14 I +$P(GMRD0,U,8)'>0 S @FDARR@(.12)=1
15 S @FDARR@(1307)=$P(GMRDACT,U,3)
16 S @FDARR@(1302)=$P(GMRDACT,U,5),@FDARR@(1303)="C"
17 S @FDARR@(1304)=$P(GMRDACT,U,19)
18 S @FDARR@(1305)=$P(GMRDACT,U,8),@FDARR@(1306)=$P(GMRDACT,U,7)
19 S @FDARR@(1401)=TIU("AD#"),@FDARR@(1402)=$P($G(TIU("TS")),U)
20 S @FDARR@(1403)=$P(GMRD0,U,13),@FDARR@(1404)=$P($G(TIU("SVC")),U)
21 S @FDARR@(1501)=$P(GMRDACT,U,4),@FDARR@(1502)=$P(GMRDACT,U,17)
22 S @FDARR@(1505)=$P(GMRDACT,U,18),@FDARR@(1506)=$$NEEDSIG(GMRDACT)
23 S @FDARR@(1507)=$P(GMRDACT,U,11),@FDARR@(1508)=$P(GMRDACT,U,20)
24 S @FDARR@(1511)=$P(GMRDACT,U,21)
25 S @FDARR@(1601)=$P(GMRDACT,U,14),@FDARR@(1602)=$P(GMRDACT,U,13)
26 S @FDARR@(1603)=$P(GMRDACT,U,15),@FDARR@(1609)=$P(GMRDACT,U,16)
27 I +$G(PARENT)>0 S @FDARR@(.06)=PARENT
28 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
29 M ^TIU(8925,+TIUDA,"TEXT")=^GMR(128,+GMRDA,"TEXT")
30 S FLAGS="EK"
31 S @FDARR@(.05)=$$STATUS^TIULC(DA)
32 S @FDARR@(1503)=$$SIGNAME^TIULS($P(GMRDACT,U,17))
33 S @FDARR@(1504)=$$SIGTITL^TIULS($P(GMRDACT,U,17))
34 S @FDARR@(1509)=$$SIGNAME^TIULS($P(GMRDACT,U,20))
35 S @FDARR@(1510)=$$SIGTITL^TIULS($P(GMRDACT,U,20))
36 S @FDARR@(1604)=$$SIGNAME^TIULS($P(GMRDACT,U,13))
37 S @FDARR@(1605)=$$SIGTITL^TIULS($P(GMRDACT,U,13))
38 D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
39 Q
40NEEDSIG(GMRDACT) ; Evaluates whether cosignature is needed
41 Q $S($P(GMRDACT,U)'=$P(GMRDACT,U,9):1,1:0)
42ADDFAIL(GMRDA) ; Log when addendum fails to convert
43 N TIUNOVCT
44 S ^GMR(128,"CNV","FAIL",GMRDA)="NO ORIGINAL FOUND FOR ADDENDUM"
45 S TIUNOVCT=+$P($G(^GMR(128,"CNV","FAIL",0)),U,2)+1
46 S $P(^GMR(128,"CNV","FAIL",0),U,2)=TIUNOVCT
47 Q
48DELETE(TIUDA) ; Delete stub should conversion fail
49 N DA,DIDEL,DIE,DR
50 S DA=TIUDA,(DIE,DIDEL)=8925,DR=".01///@" D ^DIE
51 Q
52MOVEONE ; Individual DS conversion
53 N GMRDA,TIUDFLT,TIUPRMT,TIUOUT S TIUOUT=0 W !
54 D JUSTIFY^TIUU("*** INDIVIDUAL DISCHARGE SUMMARY CONVERSION ***","C")
55 W !
56 F D Q:+$G(TIUOUT)
57 . N TIUCONT,TIUMAX
58 . S TIUDFLT=$O(^GMR(128,"CNV","FAIL",0)),TIUMAX=+$P($G(^GMR(128,0)),U,3)
59 . S TIUPRMT="Enter IEN of Summary to be Converted"
60 . S GMRDA=+$$READ^TIUU("NO^1:"_TIUMAX,TIUPRMT,TIUDFLT)
61 . I +GMRDA'>0 D Q
62 . . W !!," ... Okay then, I'm outa here!" S TIUOUT=1
63 . I +$G(^GMR(128,+GMRDA,0))'>0 D Q
64 . . W !!,"Discharge Summary Record #",GMRDA," Doesn't exist...",!
65 . . S TIUPRMT=" ... Convert another"
66 . . S TIUCONT=+$$READ^TIUU("Y",TIUPRMT,"NO") W !
67 . . S:'TIUCONT TIUOUT=1
68 . I +$G(^GMR(128,"CNV","SUCCEED",+GMRDA)) D Q
69 . . W !!,$C(7),"Discharge Summary Record #",GMRDA
70 . . W " Already converted successfully...",!
71 . . S TIUPRMT=" ... Convert another"
72 . . S TIUCONT=+$$READ^TIUU("Y",TIUPRMT,"NO") W !
73 . . S:'TIUCONT TIUOUT=1
74 . K ^GMR(128,"CNV","FAIL",GMRDA)
75 . W !!,"Alright then, here goes!"
76 . D CONVERT^TIUDSCNV(GMRDA,1)
77 . I +$G(^GMR(128,"CNV","SUCCEED",+GMRDA)) W !!,"Record #",GMRDA," Converted Successfully!",!
78 . S TIUPRMT=" ... Convert another"
79 . S TIUCONT=+$$READ^TIUU("Y",TIUPRMT,"NO") W !
80 . S:'TIUCONT TIUOUT=1
81 Q
Note: See TracBrowser for help on using the repository browser.