IBDFRPC3 ;ALB/AAS - AICS Identify patient form form id ; 12-FEB-96
;;3.0;AUTOMATED INFO COLLECTION SYS;**6,3,17**;APR 24, 1997
;
; -- used by AICS Data Entry System (routine IBDFDE)
; used by AICS Workstation software
;
IDPAT(RESULT,FORMID) ; -- Procedure
; -- Broker call to identify patient, clinic, form, and appt. from
; Encounter form ID
; rpc := IBD EXPAND FORMID
;
; -- input FORMID = pointer to form tracking (357.96)
; if Formid := Formid_"LOOKUP" then no errors created
; Result = called by reference
;
; -- output The format of the returned array is as follows
; result = $p1 := Patient Name^
; $p2 := Patient IEN
; $p3 := patient primary identifier (pid)
; $p4 := form name
; $p5 := form IEN (pointer to 357)
; $p6 := Clinic Name
; $p7 := Clinic ien
; $p8 := Clinic Physical Location
; $p9 := Appt. date/time (fm format)
; $P10:= Appt. date/time (external format)
; $P11:= Appt Status internal
; $P12:= Appt Status external
; $P13:= form input status internal
; $p14:= form input status external
; $p15:= form definition ien (357.95)
; $p16:= default provider (for clinic) internal
; $p17:= default provider (for clinic) external
; $P18:= # Scannable pages on form
; $p19:= shortedge/long edge binding
; $p20:= check out date time
;
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
K RESULT
S FORMID("SOURCE")=1
S LOOKUP=0
;
; -- formid is for lookup only
I $E(FORMID,($L(FORMID)-5),$L(FORMID))="LOOKUP" S FORMID=+FORMID,LOOKUP=1
;
; -- scanner may send in leading spaces, strip it off
I +FORMID'=FORMID,$L(FORMID) S FORMID=+$P(FORMID," ",3)
S RESULT="Form ID not a valid value, null or zero^^^"
I '$G(FORMID) D:'$G(LOOKUP) LOGERR^IBDF18E2(3579604,.FORMID) G IDPATQ
;
S RESULT="Form ID not found^^^"
S NODE=$G(^IBD(357.96,+FORMID,0))
I NODE="" D:'$G(LOOKUP) LOGERR^IBDF18E2(3579605,.FORMID) G IDPATQ
;
S DFN=+$P(NODE,"^",2)
I 'DFN S RESULT="Patient Information is Missing^^^^" G IDPATQ
S PATNM=$P($G(^DPT(DFN,0)),"^"),PID=$P($G(^DPT(DFN,.36)),"^",3)
S APPT=+$P(NODE,"^",3)
S APPTSTI=$P($G(^DPT(DFN,"S",APPT,0)),"^",2)
S APPTNM=$$FMTE^XLFDT(APPT)
;
S X=$$STATUS^SDAM1(DFN,APPT,+$G(^DPT(DFN,"S",APPT,0)),$G(^(0)))
S APPTSTE=$P(X,";",3),CO=$P(X,";",5)
I $G(^DPT(DFN,"S",APPT,0))="",CO="" D
.S CO=+$$SDV(DFN,APPT)
.I CO S APPTSTE="COMPLETE"
.I +$G(CO)<1 S APPTSTE="ACTION REQUIRED"
;
S CLIN=+$P(NODE,"^",10)
S CLINNM=$P($G(^SC(CLIN,0)),"^"),CLINPH=$P($G(^SC(CLIN,0)),"^",11)
S PROVDEF=$$PRDEF(CLIN)
S FRMDEF=$P(NODE,"^",4)
S FORM=+$P($G(^IBD(357.95,+FRMDEF,0)),"^",21)
S FORMNM=$P($G(^IBE(357,FORM,0)),"^")
S DUPLX=$P($G(^IBE(357,FORM,0)),"^",2) ; Duplex/simplex
S (SCANPG,I)=0 F S I=$O(^IBD(357.96,+FORMID,9,I)) Q:'I S SCANPG=SCANPG+1
S STATUS=$P(NODE,"^",11)
S Y=STATUS,C=$P(^DD(357.96,.11,0),"^",2) D Y^DIQ S STATNM=Y
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
;
IDPATQ Q
;
PRDEF(CLIN) ;Provider Default for Clinic
; Input -- SDCL Hospital Location file IEN
; IF DEFINED: DFN - ptr to PATIENT File
; Output -- Default
N Y,X
S Y=$P($G(^SC(+$G(CLIN),"PR",+$O(^SC("ADPR",CLIN,0)),0)),"^")
I $G(Y)="",$G(^SC(+$G(CLIN),"PC")),$D(DFN),$L($T(NMPCPR^SCAPMCU2)) S Y=+$$NMPCPR^SCAPMCU2(DFN,DT,1)
Q $G(Y)
;
SDV(DFN,APPT) ; -- try to find checkout date of stand alone encounter
N CO,IBOE,IBVAL,IBCBK
S CO="",IBOE=""
S IBVAL("DFN")=DFN,IBVAL("BDT")=APPT,IBVAL("EDT")=APPT+.000001
S IBCBK="I '$P(Y0,U,6),$P(Y0,U,8)=3 S IBOE=Y,CO=$P(Y0,U,7),SDSTOP=1"
D SCAN^IBSDU("PATIENT/DATE",.IBVAL,"",IBCBK,1)
Q CO_"^"_IBOE
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFRPC3 4267 printed Oct 16, 2024@18:54:06 Page 2
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
+2 ;
+3 ; -- used by AICS Data Entry System (routine IBDFDE)
+4 ; used by AICS Workstation software
+5 ;
IDPAT(RESULT,FORMID) ; -- Procedure
+1 ; -- Broker call to identify patient, clinic, form, and appt. from
+2 ; Encounter form ID
+3 ; rpc := IBD EXPAND FORMID
+4 ;
+5 ; -- input FORMID = pointer to form tracking (357.96)
+6 ; if Formid := Formid_"LOOKUP" then no errors created
+7 ; Result = called by reference
+8 ;
+9 ; -- output The format of the returned array is as follows
+10 ; result = $p1 := Patient Name^
+11 ; $p2 := Patient IEN
+12 ; $p3 := patient primary identifier (pid)
+13 ; $p4 := form name
+14 ; $p5 := form IEN (pointer to 357)
+15 ; $p6 := Clinic Name
+16 ; $p7 := Clinic ien
+17 ; $p8 := Clinic Physical Location
+18 ; $p9 := Appt. date/time (fm format)
+19 ; $P10:= Appt. date/time (external format)
+20 ; $P11:= Appt Status internal
+21 ; $P12:= Appt Status external
+22 ; $P13:= form input status internal
+23 ; $p14:= form input status external
+24 ; $p15:= form definition ien (357.95)
+25 ; $p16:= default provider (for clinic) internal
+26 ; $p17:= default provider (for clinic) external
+27 ; $P18:= # Scannable pages on form
+28 ; $p19:= shortedge/long edge binding
+29 ; $p20:= check out date time
+30 ;
+31 NEW 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
+32 KILL RESULT
+33 SET FORMID("SOURCE")=1
+34 SET LOOKUP=0
+35 ;
+36 ; -- formid is for lookup only
+37 IF $EXTRACT(FORMID,($LENGTH(FORMID)-5),$LENGTH(FORMID))="LOOKUP"
SET FORMID=+FORMID
SET LOOKUP=1
+38 ;
+39 ; -- scanner may send in leading spaces, strip it off
+40 IF +FORMID'=FORMID
IF $LENGTH(FORMID)
SET FORMID=+$PIECE(FORMID," ",3)
+41 SET RESULT="Form ID not a valid value, null or zero^^^"
+42 IF '$GET(FORMID)
if '$GET(LOOKUP)
DO LOGERR^IBDF18E2(3579604,.FORMID)
GOTO IDPATQ
+43 ;
+44 SET RESULT="Form ID not found^^^"
+45 SET NODE=$GET(^IBD(357.96,+FORMID,0))
+46 IF NODE=""
if '$GET(LOOKUP)
DO LOGERR^IBDF18E2(3579605,.FORMID)
GOTO IDPATQ
+47 ;
+48 SET DFN=+$PIECE(NODE,"^",2)
+49 IF 'DFN
SET RESULT="Patient Information is Missing^^^^"
GOTO IDPATQ
+50 SET PATNM=$PIECE($GET(^DPT(DFN,0)),"^")
SET PID=$PIECE($GET(^DPT(DFN,.36)),"^",3)
+51 SET APPT=+$PIECE(NODE,"^",3)
+52 SET APPTSTI=$PIECE($GET(^DPT(DFN,"S",APPT,0)),"^",2)
+53 SET APPTNM=$$FMTE^XLFDT(APPT)
+54 ;
+55 SET X=$$STATUS^SDAM1(DFN,APPT,+$GET(^DPT(DFN,"S",APPT,0)),$GET(^(0)))
+56 SET APPTSTE=$PIECE(X,";",3)
SET CO=$PIECE(X,";",5)
+57 IF $GET(^DPT(DFN,"S",APPT,0))=""
IF CO=""
Begin DoDot:1
+58 SET CO=+$$SDV(DFN,APPT)
+59 IF CO
SET APPTSTE="COMPLETE"
+60 IF +$GET(CO)<1
SET APPTSTE="ACTION REQUIRED"
End DoDot:1
+61 ;
+62 SET CLIN=+$PIECE(NODE,"^",10)
+63 SET CLINNM=$PIECE($GET(^SC(CLIN,0)),"^")
SET CLINPH=$PIECE($GET(^SC(CLIN,0)),"^",11)
+64 SET PROVDEF=$$PRDEF(CLIN)
+65 SET FRMDEF=$PIECE(NODE,"^",4)
+66 SET FORM=+$PIECE($GET(^IBD(357.95,+FRMDEF,0)),"^",21)
+67 SET FORMNM=$PIECE($GET(^IBE(357,FORM,0)),"^")
+68 ; Duplex/simplex
SET DUPLX=$PIECE($GET(^IBE(357,FORM,0)),"^",2)
+69 SET (SCANPG,I)=0
FOR
SET I=$ORDER(^IBD(357.96,+FORMID,9,I))
if 'I
QUIT
SET SCANPG=SCANPG+1
+70 SET STATUS=$PIECE(NODE,"^",11)
+71 SET Y=STATUS
SET C=$PIECE(^DD(357.96,.11,0),"^",2)
DO Y^DIQ
SET STATNM=Y
+72 SET RESULT=PATNM_"^"_DFN_"^"_PID_"^"_FORMNM_"^"_FORM_"^"_CLINNM_"^"_CLIN_"^"_CLINPH_"^"_APPT_"^"_APPTNM_"^"_APPTSTI_"^"_APPTSTE_"^"_STATUS_"^"_STATNM_"^"_FRMDEF_"^"_PROVDEF_"^"_$PIECE($GET(^VA(200,+PROVDEF,0)),"^")_"^"_SCANPG_"^"_DUPLX_"^"_CO
+73 ;
IDPATQ QUIT
+1 ;
PRDEF(CLIN) ;Provider Default for Clinic
+1 ; Input -- SDCL Hospital Location file IEN
+2 ; IF DEFINED: DFN - ptr to PATIENT File
+3 ; Output -- Default
+4 NEW Y,X
+5 SET Y=$PIECE($GET(^SC(+$GET(CLIN),"PR",+$ORDER(^SC("ADPR",CLIN,0)),0)),"^")
+6 IF $GET(Y)=""
IF $GET(^SC(+$GET(CLIN),"PC"))
IF $DATA(DFN)
IF $LENGTH($TEXT(NMPCPR^SCAPMCU2))
SET Y=+$$NMPCPR^SCAPMCU2(DFN,DT,1)
+7 QUIT $GET(Y)
+8 ;
SDV(DFN,APPT) ; -- try to find checkout date of stand alone encounter
+1 NEW CO,IBOE,IBVAL,IBCBK
+2 SET CO=""
SET IBOE=""
+3 SET IBVAL("DFN")=DFN
SET IBVAL("BDT")=APPT
SET IBVAL("EDT")=APPT+.000001
+4 SET IBCBK="I '$P(Y0,U,6),$P(Y0,U,8)=3 S IBOE=Y,CO=$P(Y0,U,7),SDSTOP=1"
+5 DO SCAN^IBSDU("PATIENT/DATE",.IBVAL,"",IBCBK,1)
+6 QUIT CO_"^"_IBOE
+7 ;
