TIUPNCV8 ;SLC/DJP - PNs ==> TIU cnv rtns ;10/5/98 15:25
;;1.0;TEXT INTEGRATION UTILITIES;**9,37**;Jun 20, 1997
;
; used to handset TIUIFN and update ^TIU(8925 appropriately
; call with REDO (TIU IFN) and GMRPIFN.
; if adding new records, set NEWNODE
;
DRIVER ;Entry point
S TIUFPRIV=1
S:'$D(U) U="^"
S (GMRPCTR,TIUCTR)=0
S:'$D(GMRPST) GMRPST=0 ;If not a Restart, initialize counter
I '$D(NEWNODE) S TIUIFN=REDO S ^TMP("TIUIFN",GMRPIFN)=TIUIFN
D MAIN
CLEANUP ;Kills variables and scratch files
K GMRPCTR,TIUCTR,GMRPST,GMRPIFN,GMRPFLD,NEWNODE,REDO
K ^TMP("TIUIFN")
Q
;
MAIN ;Main loop for each record
K DIC S DIC="^GMR(121,",DA=GMRPIFN,DIQ="PN"
S DIQ(0)="I",DR=".01:.03;.05;.06;1:7.1;9;100"
D EN^DIQ1
I (PN(121,GMRPIFN,.02,"I")="")!(PN(121,GMRPIFN,.03,"I")="")!(PN(121,GMRPIFN,.05,"I")="")!(PN(121,GMRPIFN,1,"I")="")!(PN(121,GMRPIFN,2,"I")="") D Q
. S PROBLEM="Progress Note - IFN #"_GMRPIFN_" is incomplete."
. D ERRORLOG^TIUPNCV3 K BADREC,PN,PROBLEM Q
I PN(121,GMRPIFN,100,"I"),'$D(^GMR(121,"CNV",PN(121,GMRPIFN,100,"I"))) D Q
. S PROBLEM="Progress note - IFN # "_GMRPIFN_", addendum to unconverted parent note IFN # "_PN(121,GMRPIFN,100,"I")
. D ERRORLOG^TIUPNCV3 K BADREC,PN,PROBLEM Q
D TIUFLDS
; do not convert test patient notes
S TIU("SSN")=$P(^DPT(TIU(.02),0),U,9),TIU("SSN4")=$E(TIU("SSN"),1,4)
I TIU("SSN4")["0000" D CLEANREC Q
;
D TITLE^TIUPNCV3 I $D(BADREC) D CLEANREC Q
I $D(NEWNODE) D RTNODE I $D(BADREC) D CLEANREC Q
D SETFIELD^TIUPNCV1 I $D(BADREC) D WIPEOUT Q
;Builds the TIU record
;Sets single-component record
S DIE="^TIU(8925,",DA=TIUIFN D COPY I $D(BADREC) D WIPEOUT Q
D TEXT
D:TIU(1505)'="" SIGSET D:TIU(1511)'="" COSET
;Records number of successfully processed notes
D SEND^TIUALRT(+TIUIFN)
I '$D(TIU("INDY")) S TIUCTR=TIUCTR+1
S ^GMR(121,"CNV",GMRPIFN)=TIUIFN
D CLEANREC Q
;
CLEANREC ;Cleans partition after entry of record
K TIU,ESIG,PN,ATH,P1,P2,P3,P4,P5,C1,C2,C3,PNT,BADREC,TIUD,TIUNM
K TIUT,TMSG,TYP,^TMP("TIUBRK",GMRPIFN)
Q
;
WIPEOUT ;Clears ^TIU(8925 if record is found to be incomplete
S DIK="^TIU(8925,",DA=TIUIFN D ^DIK K DIK
K ^TMP("TIUIFN",GMRPIFN)
;Next line removed **37** (Call to SUB^AUPNVSIT already in the DD)
;I $G(TIU(.03)) S X=TIU(.03) D SUB^AUPNVSIT
D CLEANREC
Q
;
TIUFLDS ;Sets TIU variables with PN data
; .01 FILE ENTRY DATE
; .02 PATIENT
; 1201 ENTRY DATE/TIME
; 1202 AUTHOR/DICTATOR - 2 AUTHOR
; 1204 EXPECTED SIGNER - 2 AUTHOR
; 1205 HOSPITAL LOCATION - 9 LOCATION
; 1301 REFERENCE DATE - .03 DATE/TIME OF PROGRESS NOTE
; 1302 ENTERED BY - .05 TRANSCRIBER
; 1501 SIGNATURE DATE/TIME - 4 DATE/TIME SIGNED
; 1502 SIGNED BY - 3 ELECTRONIC SIGNATURE (AUTHOR)
; 1506 COSIGNATURE NEEDED - 5 COSIGNATURE REQUIRED
; 1507 COSIGNATURE DATE/TIME - 7 DATE/TIME COSIGNED
; 1508 COSIGNED BY - 6 COSIGNER
; 1512 MARKED SIGNED ON CHART BY - 4.1 SIGNATURE IN CHART
; 1513 MARKED COSIGNED ON CHART BY - 7.1 COSIGNATURE IN CHART
S TIU(1201)=PN(121,GMRPIFN,.01,"I")
S TIU(.02)=PN(121,GMRPIFN,.02,"I")
S (TIU(.07),TIU(1301))=PN(121,GMRPIFN,.03,"I")
S TIU(1302)=PN(121,GMRPIFN,.05,"I")
S TIU("MHCONV")=PN(121,GMRPIFN,.06,"I")
S TIU("TITLE")=PN(121,GMRPIFN,1,"I")
S (TIU(1202),TIU(1204))=PN(121,GMRPIFN,2,"I")
S TIU(1303)="C"
S TIU(1502)=PN(121,GMRPIFN,3,"I")
S TIU(1501)=PN(121,GMRPIFN,4,"I")
S (TIU("SIGCHART"),TIU(1512))=PN(121,GMRPIFN,4.1,"I")
S TIU(1506)=PN(121,GMRPIFN,5,"I")
S TIU(1508)=PN(121,GMRPIFN,6,"I")
S TIU(1507)=PN(121,GMRPIFN,7,"I")
S (TIU("COSCHART"),TIU(1513))=PN(121,GMRPIFN,7.1,"I")
S (TIU(1205),TIU(1211))=$G(PN(121,GMRPIFN,9,"I"))
S TIU("PARENT")=$S(+PN(121,GMRPIFN,100,"I"):$G(^GMR(121,"CNV",+PN(121,GMRPIFN,100,"I"))),1:"")
S TIU("SPECDT")=$P(TIU(1201),".",1)
Q
;
RTNODE ;Sets 0 Node for TIU record
S (DIC,DLAYGO)=8925,DIC(0)="LN",X=""""_"`"_TIU(.01)_""""
D ^DIC I +Y<1 S TIU("BAD")=1 Q
S TIUIFN=+Y,^TMP("TIUIFN",GMRPIFN)=TIUIFN
Q
;
COPY ;Writes data from ^GMR(121,GMRPIFN --> ^TIU(8925,TIUIFN
S DR=".02////"_TIU(.02)_";.03////"_TIU(.03)_";.04////"_TIU(.04)_";.05////"_TIU(.05)_";.07////"_TIU(.07)_";.13////E"_";1208////"_$G(TIU(1208))_";1506////"_$G(TIU(1506)) D ^DIE
I TIU("PARENT")'="" S DR=".06////"_TIU("PARENT") D ^DIE
S DR="1201////"_TIU(1201)_";1202////"_TIU(1202)_";1204////"_$G(TIU(1204))_";1205////"_TIU(1205)_";1211////"_TIU(1211)_";1301////"_TIU(1301)_";1302////"_TIU(1302)_";1303////"_TIU(1303)
D ^DIE
I $D(TIUNEWTY) S DR=".01///"_TIUNEWTY D ^DIE K TIUNEWTY
Q
;
TEXT ;Copies text
I $D(^TMP("TIUHOLD",GMRPIFN))
I M ^TIU(8925,TIUIFN,"TEXT")=^TMP("TIUHOLD",GMRPIFN,10)
K ^TMP("TIUHOLD",GMRPIFN),^TMP("TIUMERGE",GMRPIFN) Q
M ^TIU(8925,TIUIFN,"TEXT")=^GMR(121,GMRPIFN,GMRPFLD)
Q
;
SIGSET ;Sets ^TIU(8925 signature fields
S DR="1501////"_TIU(1501)_";1502////"_TIU(1502)_";1503///^S X=TIU(1503);1504///^S X=TIU(1504);1505///"_TIU(1505)_";1512////"_TIU(1512)
D ^DIE Q
;
COSET ;Sets ^TIU(8925 co-signature fields if required
S DR="1506////"_TIU(1506)_";1507////"_TIU(1507)_";1508////"_TIU(1508)_";1509///^S X=TIU(1509);1510///^S X=TIU(1510);1511////"_TIU(1511)_";1513////"_TIU(1513)
D ^DIE Q
;
TIUPNCV8 ;SLC/DJP - PNs ==> TIU cnv rtns ;10/5/98 15:25
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**9,37**;Jun 20, 1997
+2 ;
+3 ; used to handset TIUIFN and update ^TIU(8925 appropriately
+4 ; call with REDO (TIU IFN) and GMRPIFN.
+5 ; if adding new records, set NEWNODE
+6 ;
DRIVER ;Entry point
+1 SET TIUFPRIV=1
+2 IF '$DATA(U)
SET U="^"
+3 SET (GMRPCTR,TIUCTR)=0
+4 ;If not a Restart, initialize counter
IF '$DATA(GMRPST)
SET GMRPST=0
+5 IF '$DATA(NEWNODE)
SET TIUIFN=REDO
SET ^TMP("TIUIFN",GMRPIFN)=TIUIFN
+6 DO MAIN
CLEANUP ;Kills variables and scratch files
+1 KILL GMRPCTR,TIUCTR,GMRPST,GMRPIFN,GMRPFLD,NEWNODE,REDO
+2 KILL ^TMP("TIUIFN")
+3 QUIT
+4 ;
MAIN ;Main loop for each record
+1 KILL DIC
SET DIC="^GMR(121,"
SET DA=GMRPIFN
SET DIQ="PN"
+2 SET DIQ(0)="I"
SET DR=".01:.03;.05;.06;1:7.1;9;100"
+3 DO EN^DIQ1
+4 IF (PN(121,GMRPIFN,.02,"I")="")!(PN(121,GMRPIFN,.03,"I")="")!(PN(121,GMRPIFN,.05,"I")="")!(PN(121,GMRPIFN,1,"I")="")!(PN(121,GMRPIFN,2,"I")="")
Begin DoDot:1
+5 SET PROBLEM="Progress Note - IFN #"_GMRPIFN_" is incomplete."
+6 DO ERRORLOG^TIUPNCV3
KILL BADREC,PN,PROBLEM
QUIT
End DoDot:1
QUIT
+7 IF PN(121,GMRPIFN,100,"I")
IF '$DATA(^GMR(121,"CNV",PN(121,GMRPIFN,100,"I")))
Begin DoDot:1
+8 SET PROBLEM="Progress note - IFN # "_GMRPIFN_", addendum to unconverted parent note IFN # "_PN(121,GMRPIFN,100,"I")
+9 DO ERRORLOG^TIUPNCV3
KILL BADREC,PN,PROBLEM
QUIT
End DoDot:1
QUIT
+10 DO TIUFLDS
+11 ; do not convert test patient notes
+12 SET TIU("SSN")=$PIECE(^DPT(TIU(.02),0),U,9)
SET TIU("SSN4")=$EXTRACT(TIU("SSN"),1,4)
+13 IF TIU("SSN4")["0000"
DO CLEANREC
QUIT
+14 ;
+15 DO TITLE^TIUPNCV3
IF $DATA(BADREC)
DO CLEANREC
QUIT
+16 IF $DATA(NEWNODE)
DO RTNODE
IF $DATA(BADREC)
DO CLEANREC
QUIT
+17 DO SETFIELD^TIUPNCV1
IF $DATA(BADREC)
DO WIPEOUT
QUIT
+18 ;Builds the TIU record
+19 ;Sets single-component record
+20 SET DIE="^TIU(8925,"
SET DA=TIUIFN
DO COPY
IF $DATA(BADREC)
DO WIPEOUT
QUIT
+21 DO TEXT
+22 IF TIU(1505)'=""
DO SIGSET
IF TIU(1511)'=""
DO COSET
+23 ;Records number of successfully processed notes
+24 DO SEND^TIUALRT(+TIUIFN)
+25 IF '$DATA(TIU("INDY"))
SET TIUCTR=TIUCTR+1
+26 SET ^GMR(121,"CNV",GMRPIFN)=TIUIFN
+27 DO CLEANREC
QUIT
+28 ;
CLEANREC ;Cleans partition after entry of record
+1 KILL TIU,ESIG,PN,ATH,P1,P2,P3,P4,P5,C1,C2,C3,PNT,BADREC,TIUD,TIUNM
+2 KILL TIUT,TMSG,TYP,^TMP("TIUBRK",GMRPIFN)
+3 QUIT
+4 ;
WIPEOUT ;Clears ^TIU(8925 if record is found to be incomplete
+1 SET DIK="^TIU(8925,"
SET DA=TIUIFN
DO ^DIK
KILL DIK
+2 KILL ^TMP("TIUIFN",GMRPIFN)
+3 ;Next line removed **37** (Call to SUB^AUPNVSIT already in the DD)
+4 ;I $G(TIU(.03)) S X=TIU(.03) D SUB^AUPNVSIT
+5 DO CLEANREC
+6 QUIT
+7 ;
TIUFLDS ;Sets TIU variables with PN data
+1 ; .01 FILE ENTRY DATE
+2 ; .02 PATIENT
+3 ; 1201 ENTRY DATE/TIME
+4 ; 1202 AUTHOR/DICTATOR - 2 AUTHOR
+5 ; 1204 EXPECTED SIGNER - 2 AUTHOR
+6 ; 1205 HOSPITAL LOCATION - 9 LOCATION
+7 ; 1301 REFERENCE DATE - .03 DATE/TIME OF PROGRESS NOTE
+8 ; 1302 ENTERED BY - .05 TRANSCRIBER
+9 ; 1501 SIGNATURE DATE/TIME - 4 DATE/TIME SIGNED
+10 ; 1502 SIGNED BY - 3 ELECTRONIC SIGNATURE (AUTHOR)
+11 ; 1506 COSIGNATURE NEEDED - 5 COSIGNATURE REQUIRED
+12 ; 1507 COSIGNATURE DATE/TIME - 7 DATE/TIME COSIGNED
+13 ; 1508 COSIGNED BY - 6 COSIGNER
+14 ; 1512 MARKED SIGNED ON CHART BY - 4.1 SIGNATURE IN CHART
+15 ; 1513 MARKED COSIGNED ON CHART BY - 7.1 COSIGNATURE IN CHART
+16 SET TIU(1201)=PN(121,GMRPIFN,.01,"I")
+17 SET TIU(.02)=PN(121,GMRPIFN,.02,"I")
+18 SET (TIU(.07),TIU(1301))=PN(121,GMRPIFN,.03,"I")
+19 SET TIU(1302)=PN(121,GMRPIFN,.05,"I")
+20 SET TIU("MHCONV")=PN(121,GMRPIFN,.06,"I")
+21 SET TIU("TITLE")=PN(121,GMRPIFN,1,"I")
+22 SET (TIU(1202),TIU(1204))=PN(121,GMRPIFN,2,"I")
+23 SET TIU(1303)="C"
+24 SET TIU(1502)=PN(121,GMRPIFN,3,"I")
+25 SET TIU(1501)=PN(121,GMRPIFN,4,"I")
+26 SET (TIU("SIGCHART"),TIU(1512))=PN(121,GMRPIFN,4.1,"I")
+27 SET TIU(1506)=PN(121,GMRPIFN,5,"I")
+28 SET TIU(1508)=PN(121,GMRPIFN,6,"I")
+29 SET TIU(1507)=PN(121,GMRPIFN,7,"I")
+30 SET (TIU("COSCHART"),TIU(1513))=PN(121,GMRPIFN,7.1,"I")
+31 SET (TIU(1205),TIU(1211))=$GET(PN(121,GMRPIFN,9,"I"))
+32 SET TIU("PARENT")=$SELECT(+PN(121,GMRPIFN,100,"I"):$GET(^GMR(121,"CNV",+PN(121,GMRPIFN,100,"I"))),1:"")
+33 SET TIU("SPECDT")=$PIECE(TIU(1201),".",1)
+34 QUIT
+35 ;
RTNODE ;Sets 0 Node for TIU record
+1 SET (DIC,DLAYGO)=8925
SET DIC(0)="LN"
SET X=""""_"`"_TIU(.01)_""""
+2 DO ^DIC
IF +Y<1
SET TIU("BAD")=1
QUIT
+3 SET TIUIFN=+Y
SET ^TMP("TIUIFN",GMRPIFN)=TIUIFN
+4 QUIT
+5 ;
COPY ;Writes data from ^GMR(121,GMRPIFN --> ^TIU(8925,TIUIFN
+1 SET DR=".02////"_TIU(.02)_";.03////"_TIU(.03)_";.04////"_TIU(.04)_";.05////"_TIU(.05)_";.07////"_TIU(.07)_";.13////E"_";1208////"_$GET(TIU(1208))_";1506////"_$GET(TIU(1506))
DO ^DIE
+2 IF TIU("PARENT")'=""
SET DR=".06////"_TIU("PARENT")
DO ^DIE
+3 SET DR="1201////"_TIU(1201)_";1202////"_TIU(1202)_";1204////"_$GET(TIU(1204))_";1205////"_TIU(1205)_";1211////"_TIU(1211)_";1301////"_TIU(1301)_";1302////"_TIU(1302)_";1303////"_TIU(1303)
+4 DO ^DIE
+5 IF $DATA(TIUNEWTY)
SET DR=".01///"_TIUNEWTY
DO ^DIE
KILL TIUNEWTY
+6 QUIT
+7 ;
TEXT ;Copies text
+1 IF $DATA(^TMP("TIUHOLD",GMRPIFN))
+2 IF $TEST
MERGE ^TIU(8925,TIUIFN,"TEXT")=^TMP("TIUHOLD",GMRPIFN,10)
+3 KILL ^TMP("TIUHOLD",GMRPIFN),^TMP("TIUMERGE",GMRPIFN)
QUIT
+4 MERGE ^TIU(8925,TIUIFN,"TEXT")=^GMR(121,GMRPIFN,GMRPFLD)
+5 QUIT
+6 ;
SIGSET ;Sets ^TIU(8925 signature fields
+1 SET DR="1501////"_TIU(1501)_";1502////"_TIU(1502)_";1503///^S X=TIU(1503);1504///^S X=TIU(1504);1505///"_TIU(1505)_";1512////"_TIU(1512)
+2 DO ^DIE
QUIT
+3 ;
COSET ;Sets ^TIU(8925 co-signature fields if required
+1 SET DR="1506////"_TIU(1506)_";1507////"_TIU(1507)_";1508////"_TIU(1508)_";1509///^S X=TIU(1509);1510///^S X=TIU(1510);1511////"_TIU(1511)_";1513////"_TIU(1513)
+2 DO ^DIE
QUIT
+3 ;
