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

IBDF18C.m

Go to the documentation of this file.
  1. IBDF18C ;ALB/CJM/AAS - ENCOUNTER FORM - form ID utilities ;04-OCT-94
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**5,9**;APR 24, 1997
  1. ;
  1. FID(DFN,APPT,SOURCE,FORMTYPE,CLIN) ; -- Form ID Tracking
  1. ; -- create record in the ENCOUNTER FORM TRACKING file
  1. ; and returned a unique FORM ID
  1. ; -- Input DFN = patient internal entry number
  1. ; APPT = appointment date time (fm format)
  1. ; SOURCE = the source of the form, ie
  1. ; IB = 1
  1. ; Pandas = 2
  1. ; Telefr = 3
  1. ; FORMTYPE = the package form definition ID - may have been exterally assigned
  1. ; CLIN = pointer to 44 (optional)
  1. ;
  1. ; -- Output Returns = internal form id^external form id
  1. ;
  1. N I,J,X,Y,ID,EXID,CLN,INTERNAL,NODE,FORMID,DIC,DIE,DA,DR,DINUM,DLAYGO
  1. S ID=-1,EXID=""
  1. ;
  1. I '$G(DFN)!('$G(APPT))!('$G(SOURCE)) G FIDQ
  1. ;
  1. ; -- FORMTYPE may="", but should always be >0 for scannable forms
  1. S FORMTYPE=+$G(FORMTYPE)
  1. S FORMID("APPT")=APPT,FORMID("SOURCE")=1
  1. ;
  1. ; -- determine if the FORMTYPE was exterally assigned
  1. S INTERNAL=$D(^IBD(357.95,"C",SOURCE,FORMTYPE))
  1. ;
  1. ;
  1. S ID=$$FINDID(DFN,APPT,FORMTYPE) I ID S EXID=ID_"^"_$P($G(^IBD(357.96,ID,0)),"^",9) G FIDQ
  1. K DIC,DO,D0,DD,DA,DINUM
  1. S DIC="^IBD(357.96,",X=ID,DIC(0)="L",DLAYGO=357.96,DINUM=ID
  1. ;
  1. L +^IBD(357.97,1,.02):3
  1. S ID=+$P($G(^IBD(357.97,1,0)),"^",2)
  1. F ID=ID+1:1 L:$D(^IBD(357.96,(ID-1))) -^IBD(357.96,(ID-1)) I ID>0,'$D(^IBD(357.96,ID)) L +^IBD(357.96,ID):1 I $T,'$D(^IBD(357.96,ID)) S (X,DINUM)=ID D FILE^DICN I +Y>0 L -^IBD(357.96,ID) Q
  1. S $P(^IBD(357.97,1,0),"^",2)=ID
  1. L -^IBD(357.97,1,.02)
  1. ;
  1. S ID=$S(+Y<1:"",1:+Y) I ID="" D LOGERR^IBDF18E2(3579600,.FORMID) G FIDQ
  1. D:ID
  1. .S EXID=$$EXID(ID)
  1. .S DIE="^IBD(357.96,",DA=ID
  1. .S DR="[IBD CREATE FORM TRACKING]"
  1. .L +^IBD(357.96,ID):5 D ^DIE L -^IBD(357.96,ID)
  1. .K DIC,DIE,DA,DR,DINUM,DLAYGO,%,%H,%I
  1. .;
  1. .;D NOW^%DTC N IBPRDT S IBPRDT=% ;Not needed with template, delete
  1. .;S DR=".02////^S X=DFN;.03////^S X=APPT;.04////^S X=$S(INTERNAL:FORMTYPE,1:"""");.05////^S X=IBPRDT;.07////^S X=SOURCE;.08////^S X=$S('INTERNAL:FORMTYPE,1:"""");.09////^S X=EXID;.1////^S X=$G(CLIN);.11////1"
  1. .;I $G(^DPT(DFN,"S",APPT,0))="" S DR=DR_";.14////1"
  1. FIDQ Q ID_"^"_EXID
  1. ;
  1. EXID(ID) ; -- converts external id format to internal id format
  1. ; -- we need to decide on external id format
  1. Q $G(ID)
  1. ;
  1. INID(ID) ; -- find internal id number from external format
  1. ; -- Input ID = form id in external format
  1. ; Output = form id in internal format or NULL if nonexistant
  1. ;
  1. N EXID
  1. S EXID=$O(^IBD(357.96,"AEXT",ID,0))
  1. INIDQ Q $G(EXID)
  1. ;
  1. FSCND(ID,STAT,ERR) ; -- update form tracking file that
  1. ; -- Input ID = entry to flag as scanned (internal format)
  1. ; STAT = NEW status, 1=printed, 2=scanned,3=sent to pce okay,
  1. ; 4=pce returned err
  1. ; 11=pending pages, 12=input data error
  1. ; ERR = pce error message (required only if stat=4)
  1. ;
  1. ; -- Output = 1 if successful, 0 if not
  1. ;
  1. N IBI,SUCCESS,I,J,X,Y,DA,DR,DIC,DIE
  1. S SUCCESS=0
  1. I '$G(ID) G FSCNDQ
  1. I $G(STAT)=4,$G(ERR)="" G FSCNDQ
  1. ;
  1. ; -- three lines below use template, new for t6, uncommend and delete
  1. ; remaining lines
  1. S DIE="^IBD(357.96,",DA=ID,DR="[IBD EDIT FORM TRACKING STATUS]"
  1. D ^DIE
  1. S SUCCESS=1
  1. ;
  1. ;S IBI=$G(^IBD(357.96,+ID,0)) I IBI="" G FSCND
  1. ;I $P(IBI,"^",6)="" S DIE="^IBD(357.96,",DA=ID,DR=".06///NOW;.11////^S X=$S($G(STAT):STAT,1:2);.12////^S X=$G(ERR)" D ^DIE S SUCCESS=1 G FSCNDQ
  1. ;S DIE="^IBD(357.96,",DA=+ID,DR=".11////^S X=$G(STAT);.12////^S X=$G(ERR)" D ^DIE S SUCCESS=1
  1. ;
  1. FSCNDQ Q SUCCESS
  1. ;
  1. FIDST(ID) ; -- form id status
  1. ; -- Input ID = form id (internal entry number)
  1. ;
  1. ; -- Output STATUS = -1 if id does not exist
  1. ; = 1 if id exists but not scanned (printed)
  1. ; = 2 if already scanned in
  1. ; = 3 if sent to pce okay
  1. ; = 4 if sent to pce with error....
  1. ;
  1. N STATUS,I,J,X,Y
  1. S STATUS=-1
  1. I '$G(ID) G FIDSTQ
  1. S X=$G(^IBD(357.96,ID,0)) I X="" G FIDSTQ
  1. S STATUS=$S($P(X,"^",6)="":1,1:2)
  1. S:$P(X,"^",11)>2 STATUS=$P(X,"^",11)
  1. FIDSTQ Q STATUS
  1. ;
  1. FINDID(DFN,APPT,FORM,DUP) ; -- Find a form id for a patient and appointment
  1. ; -- input DFN = patient
  1. ; APPT = appointment date time
  1. ; FORM = (Optional) type of form, pointer to 357.95 or field 10
  1. ; DUP = (Optional) if true, No duplicates of same form (357)
  1. ; returns last printing of same form with different
  1. ; form definitions, will also exclude nonscannable form
  1. ;
  1. ; -- output = form id1^form id2^form id3^form idn...
  1. ; = where form ids are successive form ids (in internal
  1. ; format) for same appointment
  1. ;
  1. N ID,I,J,X,ORIGIN,OLDDATE,NEWDATE
  1. S ID=""
  1. I '$G(DFN)!('$G(APPT)) G FINDIDQ
  1. K ^TMP($J,"IBD-FINDID")
  1. S CLN=+$G(^DPT(DFN,"S",APPT,0)) ;get clinic if appointment
  1. ;
  1. I '$G(DUP) S X=0 F S X=$O(^IBD(357.96,"APTAP",DFN,APPT,X)) Q:'X D
  1. .I CLN,CLN'=$P($G(^IBD(357.96,X,0)),"^",10) Q ;form for canceled appt.
  1. .I '$G(FORM) S ID=ID_X_"^" Q
  1. .I $G(FORM) S I=$G(^IBD(357.96,X,0)) I $P(I,"^",4)=FORM!($P(I,"^",8)=FORM) S ID=X Q
  1. ;
  1. I $G(DUP) S X=0 F S X=$O(^IBD(357.96,"APTAP",DFN,APPT,X)) Q:'X D
  1. .I +$P($G(^IBE(357,+$P($G(^IBD(357.95,+$P($G(^IBD(357.96,X,0)),"^",4),0)),"^",21),0)),"^",12)<1 Q
  1. .I CLN,CLN'=$P($G(^IBD(357.96,X,0)),"^",10) Q ;form for canceled appt.
  1. .S ORIGIN=$P($G(^IBD(357.95,+$P($G(^IBD(357.96,X,0)),"^",4),0)),"^",21) Q:'ORIGIN
  1. .I '$G(FORM) D
  1. ..I '$D(^TMP($J,"IBD-FINDID",ORIGIN)) S ^TMP($J,"IBD-FINDID",ORIGIN)=X Q
  1. ..S OLDDATE=$P($G(^IBD(357.96,+$G(^TMP("IBD-FINDID",ORIGIN)),0)),"^",5)
  1. ..S NEWDATE=$P($G(^IBD(357.96,X,0)),"^",5)
  1. ..I NEWDATE'<OLDDATE S ^TMP($J,"IBD-FINDID",ORIGIN)=X
  1. .I $G(FORM) S I=$G(^IBD(357.96,X,0)) I $P(I,"^",4)=FORM!($P(I,"^",8)=FORM) S ID=X Q
  1. I $G(DUP),'$G(FORM) S ORIGIN=0 F S ORIGIN=$O(^TMP($J,"IBD-FINDID",ORIGIN)) Q:'ORIGIN S ID=ID_^TMP($J,"IBD-FINDID",ORIGIN)_"^"
  1. ;
  1. FINDIDQ K ^TMP($J,"IBD-FINDID")
  1. Q ID
  1. ;
  1. FINDPT(FORMID) ;
  1. ; -- find patient from form id
  1. ; -- Output :Patient Name ^ PID ^ clinic Name ^ appt date/time (external)
  1. ; ^form ID ^ form status ^ DFN ^ clinic ien ^ appt date/time (fm format)
  1. ;
  1. N I,J,X,Y,DFN,IBNODE,IBXX,VA,VADM,VAERR,STATNM,FORM,FORMNM
  1. S IBXX="Unable to identify Form^^^"
  1. I +$G(FORMID)<1 G FINDPTQ
  1. S IBNODE=$G(^IBD(357.96,+FORMID,0))
  1. I IBNODE="" G FINDPTQ
  1. S DFN=+$P(IBNODE,"^",2)
  1. D DEM^VADPT
  1. S Y=$P(IBNODE,"^",11),C=$P(^DD(357.96,.11,0),"^",2) D Y^DIQ S STATNM=Y
  1. S FORM=$P($G(^IBD(357.95,+$P(IBNODE,"^",4),0)),"^",21)
  1. S FORMNM=$P($G(^IBE(357,+FORM,0)),"^")
  1. ;
  1. S IBXX=$G(VADM(1))_"^"_$G(VA("PID"))_"^"_$P($G(^SC(+$P(IBNODE,"^",10),0),"Clinic Not Specified"),"^")_"^"_$$FMTE^XLFDT($P(IBNODE,"^",3))_"^"_$P(IBNODE,"^",4)_"^"_$P(IBNODE,"^",11)_"^"_DFN
  1. S IBXX=IBXX_"^"_$P(IBNODE,"^",10)_"^"_$P(IBNODE,"^",3)_"^"_STATNM_"^"_FORMNM_"^"_FORM
  1. ;
  1. I +$P(FORMID,"^",2)>0,$P(IBNODE,"^",4)'=+$P(FORMID,"^",2) S IBXX="Form Type and Form ID Don't match^^^"
  1. ;
  1. FINDPTQ Q IBXX