IBDFPCE.m

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 ---IBDFPCE   1744     printed  Apr 09, 2024@21:54:43                                                                                                                                                                                                     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