TIUVCO ;SPFO/AJB - VistA Cutoff ;Mar 19, 2021@12:45:41
;;1.0;TEXT INTEGRATION UTILITIES;**330**;Jun 20, 1997;Build 51
;
Q
CREATE(DFN,DOC,DOCTXT,USR) ; create a new document definition
N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
N %,DG,DICR,DIW,DIC,DILOCKTM,DLAYGO,DISYS,DR,X,Y
Q:'+$G(DFN) 0_U_"Missing Patient" Q:'+$G(DOC) 0_U_"Missing Note Title" Q:'+$G(USR) 0_U_"Missing Author"
Q:'+$D(DOCTXT) 0_U_"Missing Document Text" Q:'+$G(DOCTXT) 0_U_"TEXT is empty"
N DA,PARENT,TIUFPRIV
S TIUFPRIV=1
S (DIC,DLAYGO)=8925,DIC(0)="FL",X=""""_"`"_DOC_""""
D ^DIC
S DA=+$G(Y),PARENT=$$DOCCLASS^TIULC1(+$P($G(Y),U,2))
I '+DA!('+PARENT) I +DA D DIK^TIURB2(DA)
Q:'+DA "0^Failed to create new entry." Q:'+PARENT "0^Failed to find parent type."
N CHKSUM,FDA,FDAIEN,FDAMSG,NOW S NOW=$$NOW^XLFDT
S FDA(8925,DA_",",.02)=DFN ; patient
S FDA(8925,DA_",",.04)=PARENT ; parent document type
S FDA(8925,DA_",",.05)=5 ; status unsigned
S FDA(8925,DA_",",1201)=NOW ; entry date/time
S FDA(8925,DA_",",1202)=+USR ; author
S FDA(8925,DA_",",1204)=+USR ; expected signer
S FDA(8925,DA_",",1212)=$P(USR,U,2) ; division
S FDA(8925,DA_",",1301)=NOW ; reference date/time
S FDA(8925,DA_",",1302)=+USR ; entered by
S FDA(8925,DA_",",1303)="R" ; capture method
S FDA(8925,DA_",",1304)=NOW ; release date/time
S FDA(8925,DA_",",1606)=NOW ; administrative closure date
S FDA(8925,DA_",",1607)=$P(USR,U,3) ; admin closure sig block name
S FDA(8925,DA_",",1608)=$P(USR,U,4) ; admin closure sig block title
S FDA(8925,DA_",",1613)="M" ; admin closure mode
D UPDATE^DIE("","FDA","","FDAMSG")
; set document text
S DOCTXT=DOCTXT+4,^TIU(8925,DA,"TEXT",0)="^^"_DOCTXT_U_DOCTXT_U_DT_"^^" ; set zero node
S DOCTXT=0 F S DOCTXT=$O(DOCTXT(DOCTXT)) Q:'+DOCTXT S ^TIU(8925,DA,"TEXT",DOCTXT,0)=DOCTXT(DOCTXT,0) ; set each line of text
S DOCTXT=$O(DOCTXT(DOCTXT),-1) ; get last line of text
S DOCTXT=DOCTXT+1,^TIU(8925,DA,"TEXT",DOCTXT,0)=" " ; admin closure information add to body text
S DOCTXT=DOCTXT+1,^TIU(8925,DA,"TEXT",DOCTXT,0)="Administrative Closure: "_$$DATE^TIULS(DT,"MM/DD/CCYY")
S DOCTXT=DOCTXT+1,^TIU(8925,DA,"TEXT",DOCTXT,0)=" by: "_$P(USR,U,3)
S DOCTXT=DOCTXT+1,^TIU(8925,DA,"TEXT",DOCTXT,0)=" "_$P(USR,U,4)
S CHKSUM=$$CHKSUM^TIULC("^TIU(8925,"_DA_",""TEXT"")")
S $P(^TIU(8925,DA,15),U,3)=$$ENCRYPT^TIULC1("End of report text.",1,CHKSUM)
S $P(^TIU(8925,DA,15),U,4)=$$ENCRYPT^TIULC1("["_$$FMTE^XLFDT(NOW,5)_"]",1,CHKSUM)
K FDA S FDA(8925,DA_",",.05)=7 D UPDATE^DIE("","FDA","","FDAMSG") ; status complete
S CPUCLK(2)=$$CPUTIME^XLFSHAN
S @INF@(" Duration"," zDocument Creation [CPU]")=+$G(@INF@(" Duration"," zDocument Creation [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
S STOP=$H
S @INF@(" Duration"," zDocument Creation [SECS]")=+$G(@INF@(" Duration"," zDocument Creation [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
Q DA
LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;
N DILOCKTM,DISYS
Q $$FIND1^DIC(FILE,$G(IENS),$G(FLAGS),$G(NAME),$G(INDEXES),$G(SCREEN),"ERR")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUVCO 3084 printed Apr 09, 2024@21:44:51 Page 2
TIUVCO ;SPFO/AJB - VistA Cutoff ;Mar 19, 2021@12:45:41
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**330**;Jun 20, 1997;Build 51
+2 ;
+3 QUIT
CREATE(DFN,DOC,DOCTXT,USR) ; create a new document definition
+1 NEW CPUCLK,START,STOP
SET START=$HOROLOG
SET CPUCLK(1)=$$CPUTIME^XLFSHAN
+2 NEW %,DG,DICR,DIW,DIC,DILOCKTM,DLAYGO,DISYS,DR,X,Y
+3 if '+$GET(DFN)
QUIT 0_U_"Missing Patient"
if '+$GET(DOC)
QUIT 0_U_"Missing Note Title"
if '+$GET(USR)
QUIT 0_U_"Missing Author"
+4 if '+$DATA(DOCTXT)
QUIT 0_U_"Missing Document Text"
if '+$GET(DOCTXT)
QUIT 0_U_"TEXT is empty"
+5 NEW DA,PARENT,TIUFPRIV
+6 SET TIUFPRIV=1
+7 SET (DIC,DLAYGO)=8925
SET DIC(0)="FL"
SET X=""""_"`"_DOC_""""
+8 DO ^DIC
+9 SET DA=+$GET(Y)
SET PARENT=$$DOCCLASS^TIULC1(+$PIECE($GET(Y),U,2))
+10 IF '+DA!('+PARENT)
IF +DA
DO DIK^TIURB2(DA)
+11 if '+DA
QUIT "0^Failed to create new entry."
if '+PARENT
QUIT "0^Failed to find parent type."
+12 NEW CHKSUM,FDA,FDAIEN,FDAMSG,NOW
SET NOW=$$NOW^XLFDT
+13 ; patient
SET FDA(8925,DA_",",.02)=DFN
+14 ; parent document type
SET FDA(8925,DA_",",.04)=PARENT
+15 ; status unsigned
SET FDA(8925,DA_",",.05)=5
+16 ; entry date/time
SET FDA(8925,DA_",",1201)=NOW
+17 ; author
SET FDA(8925,DA_",",1202)=+USR
+18 ; expected signer
SET FDA(8925,DA_",",1204)=+USR
+19 ; division
SET FDA(8925,DA_",",1212)=$PIECE(USR,U,2)
+20 ; reference date/time
SET FDA(8925,DA_",",1301)=NOW
+21 ; entered by
SET FDA(8925,DA_",",1302)=+USR
+22 ; capture method
SET FDA(8925,DA_",",1303)="R"
+23 ; release date/time
SET FDA(8925,DA_",",1304)=NOW
+24 ; administrative closure date
SET FDA(8925,DA_",",1606)=NOW
+25 ; admin closure sig block name
SET FDA(8925,DA_",",1607)=$PIECE(USR,U,3)
+26 ; admin closure sig block title
SET FDA(8925,DA_",",1608)=$PIECE(USR,U,4)
+27 ; admin closure mode
SET FDA(8925,DA_",",1613)="M"
+28 DO UPDATE^DIE("","FDA","","FDAMSG")
+29 ; set document text
+30 ; set zero node
SET DOCTXT=DOCTXT+4
SET ^TIU(8925,DA,"TEXT",0)="^^"_DOCTXT_U_DOCTXT_U_DT_"^^"
+31 ; set each line of text
SET DOCTXT=0
FOR
SET DOCTXT=$ORDER(DOCTXT(DOCTXT))
if '+DOCTXT
QUIT
SET ^TIU(8925,DA,"TEXT",DOCTXT,0)=DOCTXT(DOCTXT,0)
+32 ; get last line of text
SET DOCTXT=$ORDER(DOCTXT(DOCTXT),-1)
+33 ; admin closure information add to body text
SET DOCTXT=DOCTXT+1
SET ^TIU(8925,DA,"TEXT",DOCTXT,0)=" "
+34 SET DOCTXT=DOCTXT+1
SET ^TIU(8925,DA,"TEXT",DOCTXT,0)="Administrative Closure: "_$$DATE^TIULS(DT,"MM/DD/CCYY")
+35 SET DOCTXT=DOCTXT+1
SET ^TIU(8925,DA,"TEXT",DOCTXT,0)=" by: "_$PIECE(USR,U,3)
+36 SET DOCTXT=DOCTXT+1
SET ^TIU(8925,DA,"TEXT",DOCTXT,0)=" "_$PIECE(USR,U,4)
+37 SET CHKSUM=$$CHKSUM^TIULC("^TIU(8925,"_DA_",""TEXT"")")
+38 SET $PIECE(^TIU(8925,DA,15),U,3)=$$ENCRYPT^TIULC1("End of report text.",1,CHKSUM)
+39 SET $PIECE(^TIU(8925,DA,15),U,4)=$$ENCRYPT^TIULC1("["_$$FMTE^XLFDT(NOW,5)_"]",1,CHKSUM)
+40 ; status complete
KILL FDA
SET FDA(8925,DA_",",.05)=7
DO UPDATE^DIE("","FDA","","FDAMSG")
+41 SET CPUCLK(2)=$$CPUTIME^XLFSHAN
+42 SET @INF@(" Duration"," zDocument Creation [CPU]")=+$GET(@INF@(" Duration"," zDocument Creation [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
+43 SET STOP=$HOROLOG
+44 SET @INF@(" Duration"," zDocument Creation [SECS]")=+$GET(@INF@(" Duration"," zDocument Creation [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
+45 QUIT DA
LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;
+1 NEW DILOCKTM,DISYS
+2 QUIT $$FIND1^DIC(FILE,$GET(IENS),$GET(FLAGS),$GET(NAME),$GET(INDEXES),$GET(SCREEN),"ERR")
