DGFFPLM.m

DGFFPLM ; ALB/GAH - FUGITIVE FELON PROGRAM LM INQUIRY ; 10-10-2006

 ;;5.3;Registration;**485,725,1015**;Aug 13, 1993;Build 21

EN ; -- main entry point for DGFFP PATIENT STATUS INQUIRY

 N DFN,VALMCNT

 ;

 D SEL^DGFFPLM1(.DFN)

 Q:DFN'>0

 D EN^VALM("DGFFP PATIENT STATUS INQUIRY")

 Q

 ;

HDR ; -- header code

 N VA,X

 ;

 D PID^VADPT

 S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30)_" ("_VA("PID")_")"

 S VALMHDR(2)=$S($D(^DPT("AXFFP",1,DFN)):"Fugitive Flag Set",1:"")

 S VALMHDR(3)=$$LASTACT(DFN)

 Q

 ;

INIT ; -- init variables and list array

 N VALMBCK

 D BLD

 Q

 ;

BLD ; Build patient fugitive felon program screen

 D CLEAN^VALM10

 K ^TMP("DGFFPLM",$J)

 ;

 D HDR

 D EN^DGFFPLM1(DFN,"DGFFPLM",1,.VALMCNT)

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 D CLEAN^VALM10

 D CLEAR^VALM1

 K ^TMP("DGFFPLM",$J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

LASTACT(DFN) ;

 N DGCLNME,DGDT,ERRCODE,NEWDAT,OLDDAT,RSLT,SDARRAY,SDCOUNT

 ;

 S DGDT=$$NOW^XLFDT

 S SDARRAY(4)=DFN

 S SDARRAY(1)=";"_DGDT

 S SDARRAY("FLDS")=1

 S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)  ;Get all appointments for the patient

 I SDCOUNT>0 D     ;Get the last appointment date and client if records found

 . S DGCLN="",DGDT=0

 . F  S DGCLN=$O(^TMP($J,"SDAMA301",DFN,DGCLN)) Q:DGCLN=""  D

 . . S NEWDAT=+$O(^TMP($J,"SDAMA301",DFN,DGCLN,""),-1)

 . . I NEWDAT>DGDT S DGDT=NEWDAT,DGCLNME=DGCLN

 . S RSLT="Last Appointment: "_$$FMTE^XLFDT(DGDT,"1P")_"   Clinic: "_DGCLNME

 I SDCOUNT<0 S ERRCODE=$O(^TMP($J,"SDAMA301","")) I ERRCODE'="" S RSLT="Last Appointment: "_$G(^TMP($J,"SDAMA301",ERRCODE))

 K ^TMP($J,"SDAMA301")

 Q $G(RSLT)

 ;

PAT ; Entry point for DGFFP CHANGE PATIENT PROTOCOL

 ; Input  - None

 ; Output - DFN      Patient IEN

 ;          VALMBCK  R = Refresh screen

 ;

 N DGDFN

 S VALMBCK=""

 D FULL^VALM1

 ;

 ; Get new patient

 D SEL^DGFFPLM1(.DGDFN)

 ;

 I DGDFN>0 D

 . S DFN=DGDFN

 . D BLD^DGFFPLM

 S VALMBCK="R"

 Q

DGFFPLM   ; ALB/GAH - FUGITIVE FELON PROGRAM LM INQUIRY ; 10-10-2006

 +1       ;;5.3;Registration;**485,725,1015**;Aug 13, 1993;Build 21

EN        ; -- main entry point for DGFFP PATIENT STATUS INQUIRY

 +1        NEW DFN,VALMCNT

 +2       ;

 +3        DO SEL^DGFFPLM1(.DFN)

 +4        IF DFN'>0

               QUIT 

 +5        DO EN^VALM("DGFFP PATIENT STATUS INQUIRY")

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        NEW VA,X

 +2       ;

 +3        DO PID^VADPT

 +4        SET VALMHDR(1)=$EXTRACT("Patient: "_$PIECE($GET(^DPT(DFN,0)),U),1,30)_" ("_VA("PID")_")"

 +5        SET VALMHDR(2)=$SELECT($DATA(^DPT("AXFFP",1,DFN)):"Fugitive Flag Set",1:"")

 +6        SET VALMHDR(3)=$$LASTACT(DFN)

 +7        QUIT 

 +8       ;

INIT      ; -- init variables and list array

 +1        NEW VALMBCK

 +2        DO BLD

 +3        QUIT 

 +4       ;

BLD       ; Build patient fugitive felon program screen

 +1        DO CLEAN^VALM10

 +2        KILL ^TMP("DGFFPLM",$JOB)

 +3       ;

 +4        DO HDR

 +5        DO EN^DGFFPLM1(DFN,"DGFFPLM",1,.VALMCNT)

 +6        QUIT 

 +7       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        DO CLEAN^VALM10

 +2        DO CLEAR^VALM1

 +3        KILL ^TMP("DGFFPLM",$JOB)

 +4        QUIT 

 +5       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

LASTACT(DFN) ;

 +1        NEW DGCLNME,DGDT,ERRCODE,NEWDAT,OLDDAT,RSLT,SDARRAY,SDCOUNT

 +2       ;

 +3        SET DGDT=$$NOW^XLFDT

 +4        SET SDARRAY(4)=DFN

 +5        SET SDARRAY(1)=";"_DGDT

 +6        SET SDARRAY("FLDS")=1

 +7       ;Get all appointments for the patient

           SET SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)

 +8       ;Get the last appointment date and client if records found

           IF SDCOUNT>0

               Begin DoDot:1

 +9                SET DGCLN=""

                   SET DGDT=0

 +10               FOR 

                       SET DGCLN=$ORDER(^TMP($JOB,"SDAMA301",DFN,DGCLN))

                       IF DGCLN=""

                           QUIT 

                       Begin DoDot:2

 +11                       SET NEWDAT=+$ORDER(^TMP($JOB,"SDAMA301",DFN,DGCLN,""),-1)

 +12                       IF NEWDAT>DGDT

                               SET DGDT=NEWDAT

                               SET DGCLNME=DGCLN

                       End DoDot:2

 +13               SET RSLT="Last Appointment: "_$$FMTE^XLFDT(DGDT,"1P")_"   Clinic: "_DGCLNME

               End DoDot:1

 +14       IF SDCOUNT<0

               SET ERRCODE=$ORDER(^TMP($JOB,"SDAMA301",""))

               IF ERRCODE'=""

                   SET RSLT="Last Appointment: "_$GET(^TMP($JOB,"SDAMA301",ERRCODE))

 +15       KILL ^TMP($JOB,"SDAMA301")

 +16       QUIT $GET(RSLT)

 +17      ;

PAT       ; Entry point for DGFFP CHANGE PATIENT PROTOCOL

 +1       ; Input  - None

 +2       ; Output - DFN      Patient IEN

 +3       ;          VALMBCK  R = Refresh screen

 +4       ;

 +5        NEW DGDFN

 +6        SET VALMBCK=""

 +7        DO FULL^VALM1

 +8       ;

 +9       ; Get new patient

 +10       DO SEL^DGFFPLM1(.DGDFN)

 +11      ;

 +12       IF DGDFN>0

               Begin DoDot:1

 +13               SET DFN=DGDFN

 +14               DO BLD^DGFFPLM

               End DoDot:1

 +15       SET VALMBCK="R"

 +16       QUIT