DGPFLMQ1 ;ALB/RPM - PRF QUERY LISTMAN SCREEN BUILDER; 6/19/06
;;5.3;Registration;**650**;Aug 13, 1993;Build 3
;
Q ;no direct entry
;
BLDHDR(DGORF,DGPFHDR) ;build VALMHDR array
;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:
; DGORF - parsed ORF segments data array
; DGPFHDR - header array passed by reference
;
; Output:
; DGPFHDR - header array
;
N DGDFN ;pointer to patient in PATIENT (#2) file
N DGFACNAM ;facility name
N DGICN ;Integrated Control Number
N DGPFPAT ;Patient identifying info
;
S DGDFN=+$$GETDFN^MPIF001($G(@DGORF@("ICN")))
;
;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=$G(@DGORF@("ICN"))
S DGICN=$S(DGICN<0:"No ICN for patient",1:DGICN)
S DGPFHDR(2)=" ICN: "_DGICN
S DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4($G(@DGORF@("SNDFAC"))))
S DGPFHDR(2)=$$SETSTR^VALM1("FACILITY QUERIED: "_DGFACNAM,DGPFHDR(2),41,27)
Q
;
;
BLDLIST(DGORF) ;build list of returned assignments
;
; Input:
; DGORF - parsed ORF segments data array
;
; Output: none
;
D CLEAN^VALM10
N DGSET ;flag assignment indicator
;
;
S DGSET=0,VALMCNT=0
F S DGSET=$O(@DGORF@(DGSET)) Q:'DGSET D
. S VALMCNT=VALMCNT+1
. N DGPFA ;assignment data array
. ;
. ;load assignment data array
. D LDASGN^DGPFLMQ2(DGSET,DGORF,.DGPFA)
. ;
. S DGPFA("INITASSIGN")=$O(@DGORF@(DGSET,0)) ;initial assignment date
. ;
. ;get most recent assignment history to calculate current status
. S DGADT=$O(@DGORF@(DGSET,9999999.999999),-1)
. S DGPFA("STATUS")=$$STATUS^DGPFUT($G(@DGORF@(DGSET,DGADT,"ACTION")))
. S DGPFA("NUMACT")=$$NUMACT(DGSET,DGORF)
. ;
. ;build Assignment line
. D BLDLIN(VALMCNT,.DGPFA,DGSET)
;
Q
;
;
BLDLIN(DGLNUM,DGPFA,DGSET) ;build and format lines
;This procedure will build and setup ListMan lines and array.
;
; Input:
; DGLNUM - line number
; DGPFA - array containing assignment, passed by reference
; DGSET - set id representing a single PRF 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=$$EXTERNAL^DILFD(26.13,.02,"F",$G(DGPFA("FLAG")))
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG")
;
;initial assignment date
S DGTXT=$$FDATE^VALM1(+$G(DGPFA("INITASSIGN")))
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN 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")
;
;# of actions
S DGTXT=DGPFA("NUMACT")
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ACTION CNT")
;
;owner site
S DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$G(DGPFA("OWNER")))
S DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"OWNER SITE")
;
;construct initial list array and "IDX"
D SET^VALM10(DGLNUM,DGLINE,+$G(DGSET))
;
Q
;
NUMACT(DGSET,DGORF) ;count actions
;This function counts the number of assignment actions for a given
;flag assignment.
;
; Input:
; DGSET - set id representing a single PRF assignment
; DGORF - parsed ORF segments data array
;
; Output:
; Function value - count of assignment actions
;
N DGADT ;assignment date
N DGCNT ;function value
;
S DGADT=0,DGCNT=0
F S DGADT=$O(@DGORF@(DGSET,DGADT)) Q:'DGADT S DGCNT=DGCNT+1
;
Q DGCNT
;
;
DR ;Display Query Results action
;This procedure is called by the DGPF DISPLAY QUERY RESULTS action
;protocol.
;
; Input:
; DGORF - parsed ORF segments data array passed globally
;
; Output:
; VALMBCK - 'R'= refresh screen
;
N DGSET ;flag assignment indicator
N SEL ;user selection
N VALMY ;output of EN^VALM2 call, array of user selected entries
;
;set screen to full scroll region
D FULL^VALM1
;
;is action selection allowed?
I '$D(@VALMAR@("IDX")) D Q
. W !!?2,">>> '"_$P($G(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7
. W !?6,"There are no record flag assignment query results for this patient."
. D PAUSE^VALM1
. S VALMBCK="R"
;
;ask user to select a single assignment for detail display
S (SEL,VALMBCK)=""
D EN^VALM2($G(XQORNOD(0)),"S")
;
;process user selection
S SEL=$O(VALMY(""))
I SEL,$D(@VALMAR@("IDX",SEL)) D
. S DGSET=$O(@VALMAR@("IDX",SEL,""))
. ;-display query result flag assignment details
. N VALMHDR
. D EN^DGPFLMQD(DGSET,DGORF)
;
;return to LM (refresh screen)
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLMQ1 5050 printed Dec 13, 2024@02:48:19 Page 2
DGPFLMQ1 ;ALB/RPM - PRF QUERY LISTMAN SCREEN BUILDER; 6/19/06
+1 ;;5.3;Registration;**650**;Aug 13, 1993;Build 3
+2 ;
+3 ;no direct entry
QUIT
+4 ;
BLDHDR(DGORF,DGPFHDR) ;build VALMHDR array
+1 ;This procedure builds the VALMHDR array to display the ListMan header.
+2 ;
+3 ; Supported DBIA #2701: The supported DBIA is used to access the
+4 ; MPI functions to retrieve the ICN and CMOR.
+5 ;
+6 ; Input:
+7 ; DGORF - parsed ORF segments data array
+8 ; DGPFHDR - header array passed by reference
+9 ;
+10 ; Output:
+11 ; DGPFHDR - header array
+12 ;
+13 ;pointer to patient in PATIENT (#2) file
NEW DGDFN
+14 ;facility name
NEW DGFACNAM
+15 ;Integrated Control Number
NEW DGICN
+16 ;Patient identifying info
NEW DGPFPAT
+17 ;
+18 SET DGDFN=+$$GETDFN^MPIF001($GET(@DGORF@("ICN")))
+19 ;
+20 ;retrieve patient identifying info
+21 IF $$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
+22 ;
+23 ;set 1st line of header
+24 SET DGPFHDR(1)="Patient: "_$GET(DGPFPAT("NAME"))_" "
+25 SET DGPFHDR(1)=$$SETSTR^VALM1("("_$GET(DGPFPAT("SSN"))_")",DGPFHDR(1),$LENGTH(DGPFHDR(1))+1,80)
+26 SET DGPFHDR(1)=$$SETSTR^VALM1("DOB: "_$$FDATE^VALM1($GET(DGPFPAT("DOB"))),DGPFHDR(1),54,80)
+27 ;
+28 ;set 2nd line of header
+29 SET DGICN=$GET(@DGORF@("ICN"))
+30 SET DGICN=$SELECT(DGICN<0:"No ICN for patient",1:DGICN)
+31 SET DGPFHDR(2)=" ICN: "_DGICN
+32 SET DGFACNAM=$$EXTERNAL^DILFD(26.13,.04,"F",$$IEN^XUAF4($GET(@DGORF@("SNDFAC"))))
+33 SET DGPFHDR(2)=$$SETSTR^VALM1("FACILITY QUERIED: "_DGFACNAM,DGPFHDR(2),41,27)
+34 QUIT
+35 ;
+36 ;
BLDLIST(DGORF) ;build list of returned assignments
+1 ;
+2 ; Input:
+3 ; DGORF - parsed ORF segments data array
+4 ;
+5 ; Output: none
+6 ;
+7 DO CLEAN^VALM10
+8 ;flag assignment indicator
NEW DGSET
+9 ;
+10 ;
+11 SET DGSET=0
SET VALMCNT=0
+12 FOR
SET DGSET=$ORDER(@DGORF@(DGSET))
if 'DGSET
QUIT
Begin DoDot:1
+13 SET VALMCNT=VALMCNT+1
+14 ;assignment data array
NEW DGPFA
+15 ;
+16 ;load assignment data array
+17 DO LDASGN^DGPFLMQ2(DGSET,DGORF,.DGPFA)
+18 ;
+19 ;initial assignment date
SET DGPFA("INITASSIGN")=$ORDER(@DGORF@(DGSET,0))
+20 ;
+21 ;get most recent assignment history to calculate current status
+22 SET DGADT=$ORDER(@DGORF@(DGSET,9999999.999999),-1)
+23 SET DGPFA("STATUS")=$$STATUS^DGPFUT($GET(@DGORF@(DGSET,DGADT,"ACTION")))
+24 SET DGPFA("NUMACT")=$$NUMACT(DGSET,DGORF)
+25 ;
+26 ;build Assignment line
+27 DO BLDLIN(VALMCNT,.DGPFA,DGSET)
End DoDot:1
+28 ;
+29 QUIT
+30 ;
+31 ;
BLDLIN(DGLNUM,DGPFA,DGSET) ;build and format lines
+1 ;This procedure will build and setup ListMan lines and array.
+2 ;
+3 ; Input:
+4 ; DGLNUM - line number
+5 ; DGPFA - array containing assignment, passed by reference
+6 ; DGSET - set id representing a single PRF 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=$$EXTERNAL^DILFD(26.13,.02,"F",$GET(DGPFA("FLAG")))
+17 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"FLAG")
+18 ;
+19 ;initial assignment date
+20 SET DGTXT=$$FDATE^VALM1(+$GET(DGPFA("INITASSIGN")))
+21 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ASSIGN DATE")
+22 ;
+23 ;status/active (yes/no)
+24 SET DGTXT=$PIECE($GET(DGPFA("STATUS")),U)
+25 SET DGTXT=$SELECT(DGTXT=1:"YES",1:"NO")
+26 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"STATUS")
+27 ;
+28 ;# of actions
+29 SET DGTXT=DGPFA("NUMACT")
+30 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"ACTION CNT")
+31 ;
+32 ;owner site
+33 SET DGTXT=$$EXTERNAL^DILFD(26.13,.04,"F",$GET(DGPFA("OWNER")))
+34 SET DGLINE=$$SETFLD^VALM1(DGTXT,DGLINE,"OWNER SITE")
+35 ;
+36 ;construct initial list array and "IDX"
+37 DO SET^VALM10(DGLNUM,DGLINE,+$GET(DGSET))
+38 ;
+39 QUIT
+40 ;
NUMACT(DGSET,DGORF) ;count actions
+1 ;This function counts the number of assignment actions for a given
+2 ;flag assignment.
+3 ;
+4 ; Input:
+5 ; DGSET - set id representing a single PRF assignment
+6 ; DGORF - parsed ORF segments data array
+7 ;
+8 ; Output:
+9 ; Function value - count of assignment actions
+10 ;
+11 ;assignment date
NEW DGADT
+12 ;function value
NEW DGCNT
+13 ;
+14 SET DGADT=0
SET DGCNT=0
+15 FOR
SET DGADT=$ORDER(@DGORF@(DGSET,DGADT))
if 'DGADT
QUIT
SET DGCNT=DGCNT+1
+16 ;
+17 QUIT DGCNT
+18 ;
+19 ;
DR ;Display Query Results action
+1 ;This procedure is called by the DGPF DISPLAY QUERY RESULTS action
+2 ;protocol.
+3 ;
+4 ; Input:
+5 ; DGORF - parsed ORF segments data array passed globally
+6 ;
+7 ; Output:
+8 ; VALMBCK - 'R'= refresh screen
+9 ;
+10 ;flag assignment indicator
NEW DGSET
+11 ;user selection
NEW SEL
+12 ;output of EN^VALM2 call, array of user selected entries
NEW VALMY
+13 ;
+14 ;set screen to full scroll region
+15 DO FULL^VALM1
+16 ;
+17 ;is action selection allowed?
+18 IF '$DATA(@VALMAR@("IDX"))
Begin DoDot:1
+19 WRITE !!?2,">>> '"_$PIECE($GET(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7
+20 WRITE !?6,"There are no record flag assignment query results for this patient."
+21 DO PAUSE^VALM1
+22 SET VALMBCK="R"
End DoDot:1
QUIT
+23 ;
+24 ;ask user to select a single assignment for detail display
+25 SET (SEL,VALMBCK)=""
+26 DO EN^VALM2($GET(XQORNOD(0)),"S")
+27 ;
+28 ;process user selection
+29 SET SEL=$ORDER(VALMY(""))
+30 IF SEL
IF $DATA(@VALMAR@("IDX",SEL))
Begin DoDot:1
+31 SET DGSET=$ORDER(@VALMAR@("IDX",SEL,""))
+32 ;-display query result flag assignment details
+33 NEW VALMHDR
+34 DO EN^DGPFLMQD(DGSET,DGORF)
End DoDot:1
+35 ;
+36 ;return to LM (refresh screen)
+37 SET VALMBCK="R"
+38 QUIT
