TIUDSCN1 ; SLC/JER - Discharge Summary Conversion routine
;;1.0;TEXT INTEGRATION UTILITIES;**9**;Jun 20, 1997
STUFREC(DA,PARENT,GMRD0,GMRDACT) ; Stuff fixed field data
N FDA,FDARR,IENS,FLAGS,TIUMSG
S IENS=""""_DA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS="K"
S @FDARR@(.02)=$G(DFN),@FDARR@(.03)=$P($G(TIU("VISIT")),U)
S @FDARR@(.07)=$P(TIU("EDT"),U),@FDARR@(.08)=$P(TIU("LDT"),U)
S @FDARR@(.09)=$P(GMRD0,U,9),@FDARR@(.1)=$P(GMRD0,U,10)
S @FDARR@(.13)="H"
S @FDARR@(1201)=$P(GMRDACT,U,6),@FDARR@(1202)=$P(GMRDACT,U)
S @FDARR@(1205)=$P($G(TIU("LOC")),U),@FDARR@(1211)=$P($G(TIU("VLOC")),U)
S (@FDARR@(1208),@FDARR@(1209))=$P(GMRDACT,U,9)
S @FDARR@(1301)=$S(+$P(GMRD0,U,8)>0:$P(GMRD0,U,8),1:$P(GMRDACT,U,3))
I +$P(GMRD0,U,8)'>0 S @FDARR@(.12)=1
S @FDARR@(1307)=$P(GMRDACT,U,3)
S @FDARR@(1302)=$P(GMRDACT,U,5),@FDARR@(1303)="C"
S @FDARR@(1304)=$P(GMRDACT,U,19)
S @FDARR@(1305)=$P(GMRDACT,U,8),@FDARR@(1306)=$P(GMRDACT,U,7)
S @FDARR@(1401)=TIU("AD#"),@FDARR@(1402)=$P($G(TIU("TS")),U)
S @FDARR@(1403)=$P(GMRD0,U,13),@FDARR@(1404)=$P($G(TIU("SVC")),U)
S @FDARR@(1501)=$P(GMRDACT,U,4),@FDARR@(1502)=$P(GMRDACT,U,17)
S @FDARR@(1505)=$P(GMRDACT,U,18),@FDARR@(1506)=$$NEEDSIG(GMRDACT)
S @FDARR@(1507)=$P(GMRDACT,U,11),@FDARR@(1508)=$P(GMRDACT,U,20)
S @FDARR@(1511)=$P(GMRDACT,U,21)
S @FDARR@(1601)=$P(GMRDACT,U,14),@FDARR@(1602)=$P(GMRDACT,U,13)
S @FDARR@(1603)=$P(GMRDACT,U,15),@FDARR@(1609)=$P(GMRDACT,U,16)
I +$G(PARENT)>0 S @FDARR@(.06)=PARENT
D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
M ^TIU(8925,+TIUDA,"TEXT")=^GMR(128,+GMRDA,"TEXT")
S FLAGS="EK"
S @FDARR@(.05)=$$STATUS^TIULC(DA)
S @FDARR@(1503)=$$SIGNAME^TIULS($P(GMRDACT,U,17))
S @FDARR@(1504)=$$SIGTITL^TIULS($P(GMRDACT,U,17))
S @FDARR@(1509)=$$SIGNAME^TIULS($P(GMRDACT,U,20))
S @FDARR@(1510)=$$SIGTITL^TIULS($P(GMRDACT,U,20))
S @FDARR@(1604)=$$SIGNAME^TIULS($P(GMRDACT,U,13))
S @FDARR@(1605)=$$SIGTITL^TIULS($P(GMRDACT,U,13))
D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
Q
NEEDSIG(GMRDACT) ; Evaluates whether cosignature is needed
Q $S($P(GMRDACT,U)'=$P(GMRDACT,U,9):1,1:0)
ADDFAIL(GMRDA) ; Log when addendum fails to convert
N TIUNOVCT
S ^GMR(128,"CNV","FAIL",GMRDA)="NO ORIGINAL FOUND FOR ADDENDUM"
S TIUNOVCT=+$P($G(^GMR(128,"CNV","FAIL",0)),U,2)+1
S $P(^GMR(128,"CNV","FAIL",0),U,2)=TIUNOVCT
Q
DELETE(TIUDA) ; Delete stub should conversion fail
N DA,DIDEL,DIE,DR
S DA=TIUDA,(DIE,DIDEL)=8925,DR=".01///@" D ^DIE
Q
MOVEONE ; Individual DS conversion
N GMRDA,TIUDFLT,TIUPRMT,TIUOUT S TIUOUT=0 W !
D JUSTIFY^TIUU("*** INDIVIDUAL DISCHARGE SUMMARY CONVERSION ***","C")
W !
F D Q:+$G(TIUOUT)
. N TIUCONT,TIUMAX
. S TIUDFLT=$O(^GMR(128,"CNV","FAIL",0)),TIUMAX=+$P($G(^GMR(128,0)),U,3)
. S TIUPRMT="Enter IEN of Summary to be Converted"
. S GMRDA=+$$READ^TIUU("NO^1:"_TIUMAX,TIUPRMT,TIUDFLT)
. I +GMRDA'>0 D Q
. . W !!," ... Okay then, I'm outa here!" S TIUOUT=1
. I +$G(^GMR(128,+GMRDA,0))'>0 D Q
. . W !!,"Discharge Summary Record #",GMRDA," Doesn't exist...",!
. . S TIUPRMT=" ... Convert another"
. . S TIUCONT=+$$READ^TIUU("Y",TIUPRMT,"NO") W !
. . S:'TIUCONT TIUOUT=1
. I +$G(^GMR(128,"CNV","SUCCEED",+GMRDA)) D Q
. . W !!,$C(7),"Discharge Summary Record #",GMRDA
. . W " Already converted successfully...",!
. . S TIUPRMT=" ... Convert another"
. . S TIUCONT=+$$READ^TIUU("Y",TIUPRMT,"NO") W !
. . S:'TIUCONT TIUOUT=1
. K ^GMR(128,"CNV","FAIL",GMRDA)
. W !!,"Alright then, here goes!"
. D CONVERT^TIUDSCNV(GMRDA,1)
. I +$G(^GMR(128,"CNV","SUCCEED",+GMRDA)) W !!,"Record #",GMRDA," Converted Successfully!",!
. S TIUPRMT=" ... Convert another"
. S TIUCONT=+$$READ^TIUU("Y",TIUPRMT,"NO") W !
. S:'TIUCONT TIUOUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUDSCN1 3740 printed Dec 13, 2024@02:39:50 Page 2
TIUDSCN1 ; SLC/JER - Discharge Summary Conversion routine
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**9**;Jun 20, 1997
STUFREC(DA,PARENT,GMRD0,GMRDACT) ; Stuff fixed field data
+1 NEW FDA,FDARR,IENS,FLAGS,TIUMSG
+2 SET IENS=""""_DA_","""
SET FDARR="FDA(8925,"_IENS_")"
SET FLAGS="K"
+3 SET @FDARR@(.02)=$GET(DFN)
SET @FDARR@(.03)=$PIECE($GET(TIU("VISIT")),U)
+4 SET @FDARR@(.07)=$PIECE(TIU("EDT"),U)
SET @FDARR@(.08)=$PIECE(TIU("LDT"),U)
+5 SET @FDARR@(.09)=$PIECE(GMRD0,U,9)
SET @FDARR@(.1)=$PIECE(GMRD0,U,10)
+6 SET @FDARR@(.13)="H"
+7 SET @FDARR@(1201)=$PIECE(GMRDACT,U,6)
SET @FDARR@(1202)=$PIECE(GMRDACT,U)
+8 SET @FDARR@(1205)=$PIECE($GET(TIU("LOC")),U)
SET @FDARR@(1211)=$PIECE($GET(TIU("VLOC")),U)
+9 SET (@FDARR@(1208),@FDARR@(1209))=$PIECE(GMRDACT,U,9)
+10 SET @FDARR@(1301)=$SELECT(+$PIECE(GMRD0,U,8)>0:$PIECE(GMRD0,U,8),1:$PIECE(GMRDACT,U,3))
+11 IF +$PIECE(GMRD0,U,8)'>0
SET @FDARR@(.12)=1
+12 SET @FDARR@(1307)=$PIECE(GMRDACT,U,3)
+13 SET @FDARR@(1302)=$PIECE(GMRDACT,U,5)
SET @FDARR@(1303)="C"
+14 SET @FDARR@(1304)=$PIECE(GMRDACT,U,19)
+15 SET @FDARR@(1305)=$PIECE(GMRDACT,U,8)
SET @FDARR@(1306)=$PIECE(GMRDACT,U,7)
+16 SET @FDARR@(1401)=TIU("AD#")
SET @FDARR@(1402)=$PIECE($GET(TIU("TS")),U)
+17 SET @FDARR@(1403)=$PIECE(GMRD0,U,13)
SET @FDARR@(1404)=$PIECE($GET(TIU("SVC")),U)
+18 SET @FDARR@(1501)=$PIECE(GMRDACT,U,4)
SET @FDARR@(1502)=$PIECE(GMRDACT,U,17)
+19 SET @FDARR@(1505)=$PIECE(GMRDACT,U,18)
SET @FDARR@(1506)=$$NEEDSIG(GMRDACT)
+20 SET @FDARR@(1507)=$PIECE(GMRDACT,U,11)
SET @FDARR@(1508)=$PIECE(GMRDACT,U,20)
+21 SET @FDARR@(1511)=$PIECE(GMRDACT,U,21)
+22 SET @FDARR@(1601)=$PIECE(GMRDACT,U,14)
SET @FDARR@(1602)=$PIECE(GMRDACT,U,13)
+23 SET @FDARR@(1603)=$PIECE(GMRDACT,U,15)
SET @FDARR@(1609)=$PIECE(GMRDACT,U,16)
+24 IF +$GET(PARENT)>0
SET @FDARR@(.06)=PARENT
+25 ; File record
DO FILE^DIE(FLAGS,"FDA","TIUMSG")
+26 MERGE ^TIU(8925,+TIUDA,"TEXT")=^GMR(128,+GMRDA,"TEXT")
+27 SET FLAGS="EK"
+28 SET @FDARR@(.05)=$$STATUS^TIULC(DA)
+29 SET @FDARR@(1503)=$$SIGNAME^TIULS($PIECE(GMRDACT,U,17))
+30 SET @FDARR@(1504)=$$SIGTITL^TIULS($PIECE(GMRDACT,U,17))
+31 SET @FDARR@(1509)=$$SIGNAME^TIULS($PIECE(GMRDACT,U,20))
+32 SET @FDARR@(1510)=$$SIGTITL^TIULS($PIECE(GMRDACT,U,20))
+33 SET @FDARR@(1604)=$$SIGNAME^TIULS($PIECE(GMRDACT,U,13))
+34 SET @FDARR@(1605)=$$SIGTITL^TIULS($PIECE(GMRDACT,U,13))
+35 ; File record
DO FILE^DIE(FLAGS,"FDA","TIUMSG")
+36 QUIT
NEEDSIG(GMRDACT) ; Evaluates whether cosignature is needed
+1 QUIT $SELECT($PIECE(GMRDACT,U)'=$PIECE(GMRDACT,U,9):1,1:0)
ADDFAIL(GMRDA) ; Log when addendum fails to convert
+1 NEW TIUNOVCT
+2 SET ^GMR(128,"CNV","FAIL",GMRDA)="NO ORIGINAL FOUND FOR ADDENDUM"
+3 SET TIUNOVCT=+$PIECE($GET(^GMR(128,"CNV","FAIL",0)),U,2)+1
+4 SET $PIECE(^GMR(128,"CNV","FAIL",0),U,2)=TIUNOVCT
+5 QUIT
DELETE(TIUDA) ; Delete stub should conversion fail
+1 NEW DA,DIDEL,DIE,DR
+2 SET DA=TIUDA
SET (DIE,DIDEL)=8925
SET DR=".01///@"
DO ^DIE
+3 QUIT
MOVEONE ; Individual DS conversion
+1 NEW GMRDA,TIUDFLT,TIUPRMT,TIUOUT
SET TIUOUT=0
WRITE !
+2 DO JUSTIFY^TIUU("*** INDIVIDUAL DISCHARGE SUMMARY CONVERSION ***","C")
+3 WRITE !
+4 FOR
Begin DoDot:1
+5 NEW TIUCONT,TIUMAX
+6 SET TIUDFLT=$ORDER(^GMR(128,"CNV","FAIL",0))
SET TIUMAX=+$PIECE($GET(^GMR(128,0)),U,3)
+7 SET TIUPRMT="Enter IEN of Summary to be Converted"
+8 SET GMRDA=+$$READ^TIUU("NO^1:"_TIUMAX,TIUPRMT,TIUDFLT)
+9 IF +GMRDA'>0
Begin DoDot:2
+10 WRITE !!," ... Okay then, I'm outa here!"
SET TIUOUT=1
End DoDot:2
QUIT
+11 IF +$GET(^GMR(128,+GMRDA,0))'>0
Begin DoDot:2
+12 WRITE !!,"Discharge Summary Record #",GMRDA," Doesn't exist...",!
+13 SET TIUPRMT=" ... Convert another"
+14 SET TIUCONT=+$$READ^TIUU("Y",TIUPRMT,"NO")
WRITE !
+15 if 'TIUCONT
SET TIUOUT=1
End DoDot:2
QUIT
+16 IF +$GET(^GMR(128,"CNV","SUCCEED",+GMRDA))
Begin DoDot:2
+17 WRITE !!,$CHAR(7),"Discharge Summary Record #",GMRDA
+18 WRITE " Already converted successfully...",!
+19 SET TIUPRMT=" ... Convert another"
+20 SET TIUCONT=+$$READ^TIUU("Y",TIUPRMT,"NO")
WRITE !
+21 if 'TIUCONT
SET TIUOUT=1
End DoDot:2
QUIT
+22 KILL ^GMR(128,"CNV","FAIL",GMRDA)
+23 WRITE !!,"Alright then, here goes!"
+24 DO CONVERT^TIUDSCNV(GMRDA,1)
+25 IF +$GET(^GMR(128,"CNV","SUCCEED",+GMRDA))
WRITE !!,"Record #",GMRDA," Converted Successfully!",!
+26 SET TIUPRMT=" ... Convert another"
+27 SET TIUCONT=+$$READ^TIUU("Y",TIUPRMT,"NO")
WRITE !
+28 if 'TIUCONT
SET TIUOUT=1
End DoDot:1
if +$GET(TIUOUT)
QUIT
+29 QUIT
