DGPFLMU ;ALB/KCL - PRF ASSIGNMENT LISTMAN UTILITIES ; 3/06/06 3:39pm
;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
;
;no direct entry
QUIT
;
BLDHDR(DGDFN,DGPFHDR) ;This procedure builds the VALMHDR array to display the ListMan header.
;
; Supported DBIA #2701: The supported DBIA is used to access the
; MPI functions to retrieve the ICN and CMOR.
;
; Input:
; DGDFN - internal entry number of PATIENT (#2) file
; DGPFHDR - header array passed by reference
;
; Output:
; DGPFHDR - header array
;
N DGCMOR ;CIRN Master of Record
N DGICN ;Integrated Control Number
N DGPFPAT ;Patient identifying info
;
;retrieve patient identifying info
I $$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
;
;set 1st line of header
S DGPFHDR(1)="Patient: "_$G(DGPFPAT("NAME"))_" "
S DGPFHDR(1)=$$SETSTR^VALM1("("_$G(DGPFPAT("SSN"))_")",DGPFHDR(1),$L(DGPFHDR(1))+1,80)
S DGPFHDR(1)=$$SETSTR^VALM1("DOB: "_$$FDATE^VALM1($G(DGPFPAT("DOB"))),DGPFHDR(1),54,80)
;
;set 2nd line of header
S DGICN=$$GETICN^MPIF001(DGDFN)
S DGICN=$S(DGICN<0:"No ICN for patient",1:DGICN)
S DGPFHDR(2)=" ICN: "_DGICN
S DGCMOR=$$CMOR2^MPIF001(DGDFN)
S DGCMOR=$S(DGCMOR<0:$P(DGCMOR,U,2),1:DGCMOR)
S DGCMOR="CMOR: "_DGCMOR
S DGPFHDR(2)=$$SETSTR^VALM1(DGCMOR,DGPFHDR(2),53,27)
Q
;
;
BLDLIST(DGDFN) ;This procedure will build list of flag assignments for a patient for display in ListMan.
;
; Input:
; DGDFN - internal entry number of PATIENT (#2) file
;
; Output: None
;
N DGIEN ;ien of assignment
N DGIENS ;array of assignment ien's
N DGPFA ;assignment data array
N DGPFAH ;assignment history data array
N DGPTR ;pointer to last assignment history record
N DGTXT ;msg text if no assignments for patient
;
;kill data and video cntrl arrays associated with active list
D CLEAN^VALM10
;
;if no assignments, display msg, quit
K DGIENS
I '$$GETALL^DGPFAA(DGDFN,.DGIENS) D Q
. S DGTXT=" Selected patient has no record flag assignments on file."
. D SET^VALM10(1,"")
. D SET^VALM10(2,DGTXT)
. D CNTRL^VALM10(2,4,$L(DGTXT),$G(IOINHI),$G(IOINORM))
. S VALMCNT=2
;
;if assignments, get data and build list
S DGIEN=0,VALMCNT=0
F S DGIEN=$O(DGIENS(DGIEN)) Q:'DGIEN D
. ;-get assignment
. K DGPFA
. Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
. ;-get initial assignment history
. K DGPFAH
. Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
. ;-get 'initial assignment' date
. S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT"))
. Q:'DGPFAH("INITASSIGN")
. ;-increment line number count
. S VALMCNT=VALMCNT+1
. ;-build list
. D BLDLIN(VALMCNT,.DGPFA,.DGPFAH,DGIEN)
;
Q
;
;
BLDLIN(DGLNUM,DGPFA,DGPFAH,DGIEN) ;This procedure will build and setup ListMan lines and array.
;
; Input:
; DGLNUM - line number
; DGPFA - array containing assignment, passed by reference
; DGPFAH - array containing assignment history, passed by reference
; DGIEN - internal entry number of assignment
;
; Output: None
;
N DGTXT ;used as temporary text field
N DGLINE ;string to insert field data
S DGLINE="" ;init
S DGLINE=$$SETSTR^VALM1(DGLNUM,DGLINE,1,3)
;
;flag name
S DGTXT=$P($G(DGPFA("FLAG")),U,2)
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG")
;
;initial assignment date
S DGTXT=$$FDATE^VALM1(+$G(DGPFAH("INITASSIGN")))
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN DATE")
;
;review date
S DGTXT=+$G(DGPFA("REVIEWDT"))
S DGTXT=$S(DGTXT:$$FDATE^VALM1(DGTXT),1:"N/A")
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"REVIEW DATE")
;
;status/active (yes/no)
S DGTXT=$P($G(DGPFA("STATUS")),U)
S DGTXT=$S(DGTXT=1:"YES",1:"NO")
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"STATUS")
;
;local (yes/no)
S DGTXT="NO"
I $P($G(DGPFA("FLAG")),U)["26.11" S DGTXT="YES"
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"LOCAL")
;
;owner site
S DGTXT=$P($G(DGPFA("OWNER")),U,2)
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"OWNER SITE")
;
;construct initial list array
D SET^VALM10(DGLNUM,DGLINE,DGLNUM)
;
;set assignment ien and pt DFN into index
S @VALMAR@("IDX",DGLNUM,DGLNUM)=$G(DGIEN)_U_+$G(DGPFA("DFN"))
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLMU 4205 printed Sep 23, 2025@20:24:20 Page 2
DGPFLMU ;ALB/KCL - PRF ASSIGNMENT LISTMAN UTILITIES ; 3/06/06 3:39pm
+1 ;;5.3;Registration;**425,650**;Aug 13, 1993;Build 3
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
BLDHDR(DGDFN,DGPFHDR) ;This procedure builds the VALMHDR array to display the ListMan header.
+1 ;
+2 ; Supported DBIA #2701: The supported DBIA is used to access the
+3 ; MPI functions to retrieve the ICN and CMOR.
+4 ;
+5 ; Input:
+6 ; DGDFN - internal entry number of PATIENT (#2) file
+7 ; DGPFHDR - header array passed by reference
+8 ;
+9 ; Output:
+10 ; DGPFHDR - header array
+11 ;
+12 ;CIRN Master of Record
NEW DGCMOR
+13 ;Integrated Control Number
NEW DGICN
+14 ;Patient identifying info
NEW DGPFPAT
+15 ;
+16 ;retrieve patient identifying info
+17 IF $$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
+18 ;
+19 ;set 1st line of header
+20 SET DGPFHDR(1)="Patient: "_$GET(DGPFPAT("NAME"))_" "
+21 SET DGPFHDR(1)=$$SETSTR^VALM1("("_$GET(DGPFPAT("SSN"))_")",DGPFHDR(1),$LENGTH(DGPFHDR(1))+1,80)
+22 SET DGPFHDR(1)=$$SETSTR^VALM1("DOB: "_$$FDATE^VALM1($GET(DGPFPAT("DOB"))),DGPFHDR(1),54,80)
+23 ;
+24 ;set 2nd line of header
+25 SET DGICN=$$GETICN^MPIF001(DGDFN)
+26 SET DGICN=$SELECT(DGICN<0:"No ICN for patient",1:DGICN)
+27 SET DGPFHDR(2)=" ICN: "_DGICN
+28 SET DGCMOR=$$CMOR2^MPIF001(DGDFN)
+29 SET DGCMOR=$SELECT(DGCMOR<0:$PIECE(DGCMOR,U,2),1:DGCMOR)
+30 SET DGCMOR="CMOR: "_DGCMOR
+31 SET DGPFHDR(2)=$$SETSTR^VALM1(DGCMOR,DGPFHDR(2),53,27)
+32 QUIT
+33 ;
+34 ;
BLDLIST(DGDFN) ;This procedure will build list of flag assignments for a patient for display in ListMan.
+1 ;
+2 ; Input:
+3 ; DGDFN - internal entry number of PATIENT (#2) file
+4 ;
+5 ; Output: None
+6 ;
+7 ;ien of assignment
NEW DGIEN
+8 ;array of assignment ien's
NEW DGIENS
+9 ;assignment data array
NEW DGPFA
+10 ;assignment history data array
NEW DGPFAH
+11 ;pointer to last assignment history record
NEW DGPTR
+12 ;msg text if no assignments for patient
NEW DGTXT
+13 ;
+14 ;kill data and video cntrl arrays associated with active list
+15 DO CLEAN^VALM10
+16 ;
+17 ;if no assignments, display msg, quit
+18 KILL DGIENS
+19 IF '$$GETALL^DGPFAA(DGDFN,.DGIENS)
Begin DoDot:1
+20 SET DGTXT=" Selected patient has no record flag assignments on file."
+21 DO SET^VALM10(1,"")
+22 DO SET^VALM10(2,DGTXT)
+23 DO CNTRL^VALM10(2,4,$LENGTH(DGTXT),$GET(IOINHI),$GET(IOINORM))
+24 SET VALMCNT=2
End DoDot:1
QUIT
+25 ;
+26 ;if assignments, get data and build list
+27 SET DGIEN=0
SET VALMCNT=0
+28 FOR
SET DGIEN=$ORDER(DGIENS(DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+29 ;-get assignment
+30 KILL DGPFA
+31 if '$$GETASGN^DGPFAA(DGIEN,.DGPFA)
QUIT
+32 ;-get initial assignment history
+33 KILL DGPFAH
+34 if '$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
QUIT
+35 ;-get 'initial assignment' date
+36 SET DGPFAH("INITASSIGN")=$GET(DGPFAH("ASSIGNDT"))
+37 if 'DGPFAH("INITASSIGN")
QUIT
+38 ;-increment line number count
+39 SET VALMCNT=VALMCNT+1
+40 ;-build list
+41 DO BLDLIN(VALMCNT,.DGPFA,.DGPFAH,DGIEN)
End DoDot:1
+42 ;
+43 QUIT
+44 ;
+45 ;
BLDLIN(DGLNUM,DGPFA,DGPFAH,DGIEN) ;This procedure will build and setup ListMan lines and array.
+1 ;
+2 ; Input:
+3 ; DGLNUM - line number
+4 ; DGPFA - array containing assignment, passed by reference
+5 ; DGPFAH - array containing assignment history, passed by reference
+6 ; DGIEN - internal entry number of assignment
+7 ;
+8 ; Output: None
+9 ;
+10 ;used as temporary text field
NEW DGTXT
+11 ;string to insert field data
NEW DGLINE
+12 ;init
SET DGLINE=""
+13 SET DGLINE=$$SETSTR^VALM1(DGLNUM,DGLINE,1,3)
+14 ;
+15 ;flag name
+16 SET DGTXT=$PIECE($GET(DGPFA("FLAG")),U,2)
+17 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG")
+18 ;
+19 ;initial assignment date
+20 SET DGTXT=$$FDATE^VALM1(+$GET(DGPFAH("INITASSIGN")))
+21 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN DATE")
+22 ;
+23 ;review date
+24 SET DGTXT=+$GET(DGPFA("REVIEWDT"))
+25 SET DGTXT=$SELECT(DGTXT:$$FDATE^VALM1(DGTXT),1:"N/A")
+26 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"REVIEW DATE")
+27 ;
+28 ;status/active (yes/no)
+29 SET DGTXT=$PIECE($GET(DGPFA("STATUS")),U)
+30 SET DGTXT=$SELECT(DGTXT=1:"YES",1:"NO")
+31 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"STATUS")
+32 ;
+33 ;local (yes/no)
+34 SET DGTXT="NO"
+35 IF $PIECE($GET(DGPFA("FLAG")),U)["26.11"
SET DGTXT="YES"
+36 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"LOCAL")
+37 ;
+38 ;owner site
+39 SET DGTXT=$PIECE($GET(DGPFA("OWNER")),U,2)
+40 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"OWNER SITE")
+41 ;
+42 ;construct initial list array
+43 DO SET^VALM10(DGLNUM,DGLINE,DGLNUM)
+44 ;
+45 ;set assignment ien and pt DFN into index
+46 SET @VALMAR@("IDX",DGLNUM,DGLNUM)=$GET(DGIEN)_U_+$GET(DGPFA("DFN"))
+47 ;
+48 QUIT
