Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUDSCN1

TIUDSCN1.m

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