IBDFRPC5 ;ALB/AAS - AICS Pass data to PCE, Broker Call ; 24-FEB-96
;;3.0;AUTOMATED INFO COLLECTION SYS;**3,38**;APR 24, 1997
;
GETALL(RESULT,IBDATA) ; -- called by RPC and by write
; -- get all encounter data
; -- input Result (called by reference)
; IBDATA (called by reference)
; IBDATA("CLINIC") := pointer to hospital location file (44)
; IBDATA("DFN") := pointer to Patient file (2)
; IBDATA("APPT") := date/time of encounter in FM format
; IBDATA("UNFORMAT") := (optional, default :=0) return piece
; as displayable
; -- output Results Array
; A sequential array of all data found for encounters for
; patient/clinic/appt
; if ibdata(unformat) is false then data is preformatted
; suitable for display to a crt.
; if ibdata(unformat) is true then a record as follows:
; P1 := data qualifier (ie primary or secondary)
; P2 := type of data
; p3 := Narrative or Description (Textual name)
; P4 := value (code or date/time)
; P5 := source of data (aics, pce, scheduling)
; P6 := Quantity (cpt codes only)
; The next 4 pieces only set if answered
; P7 := sc (null, 1 or 0) encounter node only
; P8 := ao (null, 1 or 0) encounter node only
; P9 := ir (null, 1 or 0) encounter node only
; P10 := ec (null, 1 or 0) encounter node only
;
N CNT,IBDI,ENCTRS,L
S CNT=0,ENCTRS=""
D GETDATA(.RESULT,.IBDATA,.ENCTRS)
S L=" "
I +RESULT(0) S RESULT(0)="The following data was found: " D FINDALL^IBDFRPC6(.RESULT)
;F IBDI="VST","PRV","POV","CPT","HF","PED","XAM","SK","IMM","TRT" D @(IBDI_"^IBDFRPC6")
GETALLQ Q
;
GETDATA(RESULT,IBDATA,ENCTRS) ; -- return all data for an encounter date time
;
N IBDJ,IBDY
K ^TMP("PXKENC",$J)
I +IBDATA("CLINIC")'=IBDATA("CLINIC"),IBDATA("CLINIC")'="" S IBDATA("CLINIC")=$O(^SC("B",IBDATA("CLINIC"),0))
S RESULT(0)="Nothing Processed, Perhaps an Error Occurred"
I $G(IBDATA("DFN"))<1!($G(IBDATA("APPT"))<1)!($G(IBDATA("CLINIC"))<1) S RESULT(0)="Insufficient Data Passed to find encounter data" G GETQ
;
; -- first get visit iens
S ENCTRS=$$GETENC^PXAPI(IBDATA("DFN"),IBDATA("APPT"),IBDATA("CLINIC"))
I ENCTRS=-1 S RESULT(0)="No encounter Data on file." G GETQ
I ENCTRS=-2 S RESULT(0)="Error in calling routine, file a NOIS" G GETQ
;
; -- then get all visit data
S RESULT(0)="Attempting to Retieve Data"
F IBDJ=1:1 S IBDY=$P(ENCTRS,"^",IBDJ) Q:IBDY="" D ENCEVENT^PXAPI(IBDY,1)
;
S RESULT(0)="1"
GETQ Q
;
WRITE ; -- called by DIR as executable help from IBDFDE
N RESULT,IBQUIT,I,CNT
W !,"Retrieving Encounter Data from PCE..."
D GETALL(.RESULT,.IBDF)
W !
S I="",IBQUIT=0,CNT=0
F S I=$O(RESULT(I)) Q:I="" S CNT=CNT+1 D:'(CNT#10) PAUSE^IBDFDE Q:IBQUIT W !,RESULT(I)
Q
;
APPTLST(RESULT,IBDF) ; -- return past appointment list, called by rpc
N I,J,CNT,DFN,VASD,VAERR,VAROOT
S RESULT(0)="No Past Appointments Found^^"
K ^UTILITY("VASD",$J)
;
S DFN=+$G(IBDF("DFN"))
S VASD("F")=$S($G(IBDF("F"))>2840000:IBDF("F"),1:DT-10000)
S VASD("T")=$S($G(IBDF("T"))>2840000:IBDF("T"),1:DT+.24)
S VASD("W")=$S($G(IBDF("W"))'="":IBDF("W"),1:"129")
;
D SDA^VADPT
;
I $O(^UTILITY("VASD",$J,"")) S CNT=0
S I="" F S I=$O(^UTILITY("VASD",$J,I),-1) Q:I="" S RESULT(CNT)=$G(^UTILITY("VASD",$J,I,"E"))_"^"_$G(^UTILITY("VASD",$J,I,"I")),CNT=CNT+1
;
I VAERR=1 S RESULT(0)="Invalid Patient Identifier^^"
K ^UTILITY("VASD",$J)
Q
;
TEST ;
K IBDF,ALAN
S IBDF("DFN")=7169761
S IBDF("CLINIC")=300
S IBDF("APPT")=2970902.0849
S IBDF("UNFORMAT")=1
D GETALL(.ALAN,.IBDF)
Q
TESTW ;
K IBDF
S IBDF("DFN")=7169761
S IBDF("CLINIC")=300
S IBDF("APPT")=2970902.0849
D WRITE
K IBDF
Q
;
TESTA ;
K ALAN,IBDF
S IBDF("DFN")=7169761
D APPTLST(.ALAN,.IBDF)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFRPC5 4085 printed Apr 09, 2024@20:58:12 Page 2
IBDFRPC5 ;ALB/AAS - AICS Pass data to PCE, Broker Call ; 24-FEB-96
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**3,38**;APR 24, 1997
+2 ;
GETALL(RESULT,IBDATA) ; -- called by RPC and by write
+1 ; -- get all encounter data
+2 ; -- input Result (called by reference)
+3 ; IBDATA (called by reference)
+4 ; IBDATA("CLINIC") := pointer to hospital location file (44)
+5 ; IBDATA("DFN") := pointer to Patient file (2)
+6 ; IBDATA("APPT") := date/time of encounter in FM format
+7 ; IBDATA("UNFORMAT") := (optional, default :=0) return piece
+8 ; as displayable
+9 ; -- output Results Array
+10 ; A sequential array of all data found for encounters for
+11 ; patient/clinic/appt
+12 ; if ibdata(unformat) is false then data is preformatted
+13 ; suitable for display to a crt.
+14 ; if ibdata(unformat) is true then a record as follows:
+15 ; P1 := data qualifier (ie primary or secondary)
+16 ; P2 := type of data
+17 ; p3 := Narrative or Description (Textual name)
+18 ; P4 := value (code or date/time)
+19 ; P5 := source of data (aics, pce, scheduling)
+20 ; P6 := Quantity (cpt codes only)
+21 ; The next 4 pieces only set if answered
+22 ; P7 := sc (null, 1 or 0) encounter node only
+23 ; P8 := ao (null, 1 or 0) encounter node only
+24 ; P9 := ir (null, 1 or 0) encounter node only
+25 ; P10 := ec (null, 1 or 0) encounter node only
+26 ;
+27 NEW CNT,IBDI,ENCTRS,L
+28 SET CNT=0
SET ENCTRS=""
+29 DO GETDATA(.RESULT,.IBDATA,.ENCTRS)
+30 SET L=" "
+31 IF +RESULT(0)
SET RESULT(0)="The following data was found: "
DO FINDALL^IBDFRPC6(.RESULT)
+32 ;F IBDI="VST","PRV","POV","CPT","HF","PED","XAM","SK","IMM","TRT" D @(IBDI_"^IBDFRPC6")
GETALLQ QUIT
+1 ;
GETDATA(RESULT,IBDATA,ENCTRS) ; -- return all data for an encounter date time
+1 ;
+2 NEW IBDJ,IBDY
+3 KILL ^TMP("PXKENC",$JOB)
+4 IF +IBDATA("CLINIC")'=IBDATA("CLINIC")
IF IBDATA("CLINIC")'=""
SET IBDATA("CLINIC")=$ORDER(^SC("B",IBDATA("CLINIC"),0))
+5 SET RESULT(0)="Nothing Processed, Perhaps an Error Occurred"
+6 IF $GET(IBDATA("DFN"))<1!($GET(IBDATA("APPT"))<1)!($GET(IBDATA("CLINIC"))<1)
SET RESULT(0)="Insufficient Data Passed to find encounter data"
GOTO GETQ
+7 ;
+8 ; -- first get visit iens
+9 SET ENCTRS=$$GETENC^PXAPI(IBDATA("DFN"),IBDATA("APPT"),IBDATA("CLINIC"))
+10 IF ENCTRS=-1
SET RESULT(0)="No encounter Data on file."
GOTO GETQ
+11 IF ENCTRS=-2
SET RESULT(0)="Error in calling routine, file a NOIS"
GOTO GETQ
+12 ;
+13 ; -- then get all visit data
+14 SET RESULT(0)="Attempting to Retieve Data"
+15 FOR IBDJ=1:1
SET IBDY=$PIECE(ENCTRS,"^",IBDJ)
if IBDY=""
QUIT
DO ENCEVENT^PXAPI(IBDY,1)
+16 ;
+17 SET RESULT(0)="1"
GETQ QUIT
+1 ;
WRITE ; -- called by DIR as executable help from IBDFDE
+1 NEW RESULT,IBQUIT,I,CNT
+2 WRITE !,"Retrieving Encounter Data from PCE..."
+3 DO GETALL(.RESULT,.IBDF)
+4 WRITE !
+5 SET I=""
SET IBQUIT=0
SET CNT=0
+6 FOR
SET I=$ORDER(RESULT(I))
if I=""
QUIT
SET CNT=CNT+1
if '(CNT#10)
DO PAUSE^IBDFDE
if IBQUIT
QUIT
WRITE !,RESULT(I)
+7 QUIT
+8 ;
APPTLST(RESULT,IBDF) ; -- return past appointment list, called by rpc
+1 NEW I,J,CNT,DFN,VASD,VAERR,VAROOT
+2 SET RESULT(0)="No Past Appointments Found^^"
+3 KILL ^UTILITY("VASD",$JOB)
+4 ;
+5 SET DFN=+$GET(IBDF("DFN"))
+6 SET VASD("F")=$SELECT($GET(IBDF("F"))>2840000:IBDF("F"),1:DT-10000)
+7 SET VASD("T")=$SELECT($GET(IBDF("T"))>2840000:IBDF("T"),1:DT+.24)
+8 SET VASD("W")=$SELECT($GET(IBDF("W"))'="":IBDF("W"),1:"129")
+9 ;
+10 DO SDA^VADPT
+11 ;
+12 IF $ORDER(^UTILITY("VASD",$JOB,""))
SET CNT=0
+13 SET I=""
FOR
SET I=$ORDER(^UTILITY("VASD",$JOB,I),-1)
if I=""
QUIT
SET RESULT(CNT)=$GET(^UTILITY("VASD",$JOB,I,"E"))_"^"_$GET(^UTILITY("VASD",$JOB,I,"I"))
SET CNT=CNT+1
+14 ;
+15 IF VAERR=1
SET RESULT(0)="Invalid Patient Identifier^^"
+16 KILL ^UTILITY("VASD",$JOB)
+17 QUIT
+18 ;
TEST ;
+1 KILL IBDF,ALAN
+2 SET IBDF("DFN")=7169761
+3 SET IBDF("CLINIC")=300
+4 SET IBDF("APPT")=2970902.0849
+5 SET IBDF("UNFORMAT")=1
+6 DO GETALL(.ALAN,.IBDF)
+7 QUIT
TESTW ;
+1 KILL IBDF
+2 SET IBDF("DFN")=7169761
+3 SET IBDF("CLINIC")=300
+4 SET IBDF("APPT")=2970902.0849
+5 DO WRITE
+6 KILL IBDF
+7 QUIT
+8 ;
TESTA ;
+1 KILL ALAN,IBDF
+2 SET IBDF("DFN")=7169761
+3 DO APPTLST(.ALAN,.IBDF)
+4 QUIT
