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

IBDFRPC3.m

Go to the documentation of this file.
  1. IBDFRPC3 ;ALB/AAS - AICS Identify patient form form id ; 12-FEB-96
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**6,3,17**;APR 24, 1997
  1. ;
  1. ; -- used by AICS Data Entry System (routine IBDFDE)
  1. ; used by AICS Workstation software
  1. ;
  1. IDPAT(RESULT,FORMID) ; -- Procedure
  1. ; -- Broker call to identify patient, clinic, form, and appt. from
  1. ; Encounter form ID
  1. ; rpc := IBD EXPAND FORMID
  1. ;
  1. ; -- input FORMID = pointer to form tracking (357.96)
  1. ; if Formid := Formid_"LOOKUP" then no errors created
  1. ; Result = called by reference
  1. ;
  1. ; -- output The format of the returned array is as follows
  1. ; result = $p1 := Patient Name^
  1. ; $p2 := Patient IEN
  1. ; $p3 := patient primary identifier (pid)
  1. ; $p4 := form name
  1. ; $p5 := form IEN (pointer to 357)
  1. ; $p6 := Clinic Name
  1. ; $p7 := Clinic ien
  1. ; $p8 := Clinic Physical Location
  1. ; $p9 := Appt. date/time (fm format)
  1. ; $P10:= Appt. date/time (external format)
  1. ; $P11:= Appt Status internal
  1. ; $P12:= Appt Status external
  1. ; $P13:= form input status internal
  1. ; $p14:= form input status external
  1. ; $p15:= form definition ien (357.95)
  1. ; $p16:= default provider (for clinic) internal
  1. ; $p17:= default provider (for clinic) external
  1. ; $P18:= # Scannable pages on form
  1. ; $p19:= shortedge/long edge binding
  1. ; $p20:= check out date time
  1. ;
  1. N C,I,J,X,Y,NODE,PATNM,DFN,PID,CLIN,CLINNM,FORMNM,FORM,APPT,APPTNM,STATUS,STATNM,FRMDEF,PROVDEF,APPTSTI,APPTSTE,CLINPH,DUPLX,SCANPG,CO,LOOKUP
  1. K RESULT
  1. S FORMID("SOURCE")=1
  1. S LOOKUP=0
  1. ;
  1. ; -- formid is for lookup only
  1. I $E(FORMID,($L(FORMID)-5),$L(FORMID))="LOOKUP" S FORMID=+FORMID,LOOKUP=1
  1. ;
  1. ; -- scanner may send in leading spaces, strip it off
  1. I +FORMID'=FORMID,$L(FORMID) S FORMID=+$P(FORMID," ",3)
  1. S RESULT="Form ID not a valid value, null or zero^^^"
  1. I '$G(FORMID) D:'$G(LOOKUP) LOGERR^IBDF18E2(3579604,.FORMID) G IDPATQ
  1. ;
  1. S RESULT="Form ID not found^^^"
  1. S NODE=$G(^IBD(357.96,+FORMID,0))
  1. I NODE="" D:'$G(LOOKUP) LOGERR^IBDF18E2(3579605,.FORMID) G IDPATQ
  1. ;
  1. S DFN=+$P(NODE,"^",2)
  1. I 'DFN S RESULT="Patient Information is Missing^^^^" G IDPATQ
  1. S PATNM=$P($G(^DPT(DFN,0)),"^"),PID=$P($G(^DPT(DFN,.36)),"^",3)
  1. S APPT=+$P(NODE,"^",3)
  1. S APPTSTI=$P($G(^DPT(DFN,"S",APPT,0)),"^",2)
  1. S APPTNM=$$FMTE^XLFDT(APPT)
  1. ;
  1. S X=$$STATUS^SDAM1(DFN,APPT,+$G(^DPT(DFN,"S",APPT,0)),$G(^(0)))
  1. S APPTSTE=$P(X,";",3),CO=$P(X,";",5)
  1. I $G(^DPT(DFN,"S",APPT,0))="",CO="" D
  1. .S CO=+$$SDV(DFN,APPT)
  1. .I CO S APPTSTE="COMPLETE"
  1. .I +$G(CO)<1 S APPTSTE="ACTION REQUIRED"
  1. ;
  1. S CLIN=+$P(NODE,"^",10)
  1. S CLINNM=$P($G(^SC(CLIN,0)),"^"),CLINPH=$P($G(^SC(CLIN,0)),"^",11)
  1. S PROVDEF=$$PRDEF(CLIN)
  1. S FRMDEF=$P(NODE,"^",4)
  1. S FORM=+$P($G(^IBD(357.95,+FRMDEF,0)),"^",21)
  1. S FORMNM=$P($G(^IBE(357,FORM,0)),"^")
  1. S DUPLX=$P($G(^IBE(357,FORM,0)),"^",2) ; Duplex/simplex
  1. S (SCANPG,I)=0 F S I=$O(^IBD(357.96,+FORMID,9,I)) Q:'I S SCANPG=SCANPG+1
  1. S STATUS=$P(NODE,"^",11)
  1. S Y=STATUS,C=$P(^DD(357.96,.11,0),"^",2) D Y^DIQ S STATNM=Y
  1. S RESULT=PATNM_"^"_DFN_"^"_PID_"^"_FORMNM_"^"_FORM_"^"_CLINNM_"^"_CLIN_"^"_CLINPH_"^"_APPT_"^"_APPTNM_"^"_APPTSTI_"^"_APPTSTE_"^"_STATUS_"^"_STATNM_"^"_FRMDEF_"^"_PROVDEF_"^"_$P($G(^VA(200,+PROVDEF,0)),"^")_"^"_SCANPG_"^"_DUPLX_"^"_CO
  1. ;
  1. IDPATQ Q
  1. ;
  1. PRDEF(CLIN) ;Provider Default for Clinic
  1. ; Input -- SDCL Hospital Location file IEN
  1. ; IF DEFINED: DFN - ptr to PATIENT File
  1. ; Output -- Default
  1. N Y,X
  1. S Y=$P($G(^SC(+$G(CLIN),"PR",+$O(^SC("ADPR",CLIN,0)),0)),"^")
  1. I $G(Y)="",$G(^SC(+$G(CLIN),"PC")),$D(DFN),$L($T(NMPCPR^SCAPMCU2)) S Y=+$$NMPCPR^SCAPMCU2(DFN,DT,1)
  1. Q $G(Y)
  1. ;
  1. SDV(DFN,APPT) ; -- try to find checkout date of stand alone encounter
  1. N CO,IBOE,IBVAL,IBCBK
  1. S CO="",IBOE=""
  1. S IBVAL("DFN")=DFN,IBVAL("BDT")=APPT,IBVAL("EDT")=APPT+.000001
  1. S IBCBK="I '$P(Y0,U,6),$P(Y0,U,8)=3 S IBOE=Y,CO=$P(Y0,U,7),SDSTOP=1"
  1. D SCAN^IBSDU("PATIENT/DATE",.IBVAL,"",IBCBK,1)
  1. Q CO_"^"_IBOE
  1. ;