- 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 Feb 19, 2025@00:19:46 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 ;