- 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 Feb 19, 2025@00:06:18 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