IBDFPCE ;ALB/AAS - AICS UPDATE FROM PCE ; 12-DEC-95
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
MAN ; -- called from IBDF PCE EVENT (invoked by the PXK VISIT DATA EVENT)
; if aics starts event, quit
; else
; find appointment date from visit node
; find entry in forms tracking for visit
; update manual data entry field to yes if new or old visit edited
; update manual data entry field to no if entry deleted
;
Q:$D(IBD("AICS"))
N IBDVST,IBD,IBDFN
S (IBDVST,IBDFN)=""
;
F S IBDVST=$O(^TMP("PXKCO",$J,IBDVST)) Q:'IBDVST D
.S IBDVST("AFTER")=$G(^TMP("PXKCO",$J,IBDVST,"VST",IBDVST,0,"AFTER")),IBDVST("BEFORE")=$G(^("BEFORE"))
.;
.; -- new or old visit
.I IBDVST("AFTER")]"",IBDVST("BEFORE")]""!(IBDVST("BEFORE")="") S IBD("APPT")=+IBDVST("AFTER"),IBD("VALUE")=1,IBDFN=$P(IBDVST("AFTER"),"^",5) D UPDATE(.IBD) Q
.;
.; -- deleted visit
.I IBDVST("AFTER")="",IBDVST("BEFORE")]"" S IBD("APPT")=+IBDVST("BEFORE"),IBD("VALUE")=0,IBDFN=$P(IBDVST("BEFORE"),"^",5) D UPDATE(.IBD) Q
;
Q
;
UPDATE(IBD) ; -- procedure to update manual data entry detected
;
N X,Y,DA,DIC,DIE,DR,IBDX,IBDC
Q:'$G(IBDFN)!('$G(IBD("APPT")))!('$G(IBD("VALUE")))
I '$D(IBD("FORM ID")) S IBD("FORM ID")=$$FINDID^IBDF18C(IBDFN,IBD("APPT"))
;
; -- ibd(form id) can be returned with multiple pieces if more than
; one form for appt.
F IBDX=1:1 S DA=+$P(IBD("FORM ID"),"^",IBDX) Q:'DA D
. Q:$P($G(^IBD(357.96,+DA,0)),"^",13)
. Q:$P($G(^IBD(357.96,+DA,0)),"^",2)'=IBDFN
. Q:$P($G(^IBD(357.96,+DA,0)),"^",3)'=IBD("APPT")
. S DIE="^IBD(357.96,",DR=".13////"_+$G(IBD("VALUE"))
. D ^DIE S IBDC=$G(IBDC)+1
. I IBDC=1,'$D(ZTQUEUED) W !,"Updating Encounter Form Tracking (AICS)"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFPCE 1744 printed Oct 16, 2024@18:53:51 Page 2
IBDFPCE ;ALB/AAS - AICS UPDATE FROM PCE ; 12-DEC-95
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
MAN ; -- called from IBDF PCE EVENT (invoked by the PXK VISIT DATA EVENT)
+1 ; if aics starts event, quit
+2 ; else
+3 ; find appointment date from visit node
+4 ; find entry in forms tracking for visit
+5 ; update manual data entry field to yes if new or old visit edited
+6 ; update manual data entry field to no if entry deleted
+7 ;
+8 if $DATA(IBD("AICS"))
QUIT
+9 NEW IBDVST,IBD,IBDFN
+10 SET (IBDVST,IBDFN)=""
+11 ;
+12 FOR
SET IBDVST=$ORDER(^TMP("PXKCO",$JOB,IBDVST))
if 'IBDVST
QUIT
Begin DoDot:1
+13 SET IBDVST("AFTER")=$GET(^TMP("PXKCO",$JOB,IBDVST,"VST",IBDVST,0,"AFTER"))
SET IBDVST("BEFORE")=$GET(^("BEFORE"))
+14 ;
+15 ; -- new or old visit
+16 IF IBDVST("AFTER")]""
IF IBDVST("BEFORE")]""!(IBDVST("BEFORE")="")
SET IBD("APPT")=+IBDVST("AFTER")
SET IBD("VALUE")=1
SET IBDFN=$PIECE(IBDVST("AFTER"),"^",5)
DO UPDATE(.IBD)
QUIT
+17 ;
+18 ; -- deleted visit
+19 IF IBDVST("AFTER")=""
IF IBDVST("BEFORE")]""
SET IBD("APPT")=+IBDVST("BEFORE")
SET IBD("VALUE")=0
SET IBDFN=$PIECE(IBDVST("BEFORE"),"^",5)
DO UPDATE(.IBD)
QUIT
End DoDot:1
+20 ;
+21 QUIT
+22 ;
UPDATE(IBD) ; -- procedure to update manual data entry detected
+1 ;
+2 NEW X,Y,DA,DIC,DIE,DR,IBDX,IBDC
+3 if '$GET(IBDFN)!('$GET(IBD("APPT")))!('$GET(IBD("VALUE")))
QUIT
+4 IF '$DATA(IBD("FORM ID"))
SET IBD("FORM ID")=$$FINDID^IBDF18C(IBDFN,IBD("APPT"))
+5 ;
+6 ; -- ibd(form id) can be returned with multiple pieces if more than
+7 ; one form for appt.
+8 FOR IBDX=1:1
SET DA=+$PIECE(IBD("FORM ID"),"^",IBDX)
if 'DA
QUIT
Begin DoDot:1
+9 if $PIECE($GET(^IBD(357.96,+DA,0)),"^",13)
QUIT
+10 if $PIECE($GET(^IBD(357.96,+DA,0)),"^",2)'=IBDFN
QUIT
+11 if $PIECE($GET(^IBD(357.96,+DA,0)),"^",3)'=IBD("APPT")
QUIT
+12 SET DIE="^IBD(357.96,"
SET DR=".13////"_+$GET(IBD("VALUE"))
+13 DO ^DIE
SET IBDC=$GET(IBDC)+1
+14 IF IBDC=1
IF '$DATA(ZTQUEUED)
WRITE !,"Updating Encounter Form Tracking (AICS)"
End DoDot:1
+15 QUIT
