- DGFFPLM ; ALB/GAH - FUGITIVE FELON PROGRAM LM INQUIRY ; 10-10-2006
- ;;5.3;Registration;**485,725**;Aug 13, 1993;Build 12
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGFFPLM 1984 printed Feb 19, 2025@00:09:35 Page 2
- DGFFPLM ; ALB/GAH - FUGITIVE FELON PROGRAM LM INQUIRY ; 10-10-2006
- +1 ;;5.3;Registration;**485,725**;Aug 13, 1993;Build 12
- 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