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

TIUPNCV8.m

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