DGPFLMA1 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS ; 6/10/03 3:57pm
;;5.3;Registration;**425**;Aug 13, 1993
;
;no direct entry
QUIT
;
SP ;Entry point for DGPF SELECT PATIENT action protocol.
;
; Input: None
;
; Output:
; DGDFN - pointer to patient in PATIENT #2 file
; VALMBCK - 'R' = refresh screen
;
N DGPAT ;patient lookup array
;
;set screen to full scrolling region
D FULL^VALM1
;
;patient selection (lookup)
D SELPAT^DGPFUT1(.DGPAT)
I (+$G(DGPAT)>0) D
. S DGDFN=+DGPAT
. ;
. Q:'$$CONTINUE^DGPFUT()
. ;
. ;- build header for selected patient
. D BLDHDR^DGPFLMU(DGDFN,.VALMHDR)
. ;
. ;- build list of flag assignments for selected patient
. D BLDLIST^DGPFLMU(DGDFN)
;
;return to LM (refresh screen)
S VALMBCK="R"
Q
;
;
DF ;Entry point for DGPF DISPLAY ASSIGNMENT DETAIL action protocol.
;
; Input: None
;
; Output:
; VALMBCK - 'R' = refresh screen
;
N DGDFN ;patient dfn
N DGIEN ;assignment ien
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
. I '$G(DGDFN) W !?6,"A patient has not been selected."
. E W !?6,"There are no record flag assignments for this patient."
. D PAUSE^VALM1
. S VALMBCK="R"
;
;ask user to select a single assignment for detail display
S (SEL,DGIEN,VALMBCK)=""
D EN^VALM2($G(XQORNOD(0)),"S")
;
;process user selection
S SEL=$O(VALMY(""))
I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
. S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U)
. S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2)
. ;-display flag assignment details
. N VALMHDR
. D EN^DGPFLMAD
;
;return to LM (refresh screen)
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLMA1 1903 printed Dec 13, 2024@02:48:11 Page 2
DGPFLMA1 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS ; 6/10/03 3:57pm
+1 ;;5.3;Registration;**425**;Aug 13, 1993
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
SP ;Entry point for DGPF SELECT PATIENT action protocol.
+1 ;
+2 ; Input: None
+3 ;
+4 ; Output:
+5 ; DGDFN - pointer to patient in PATIENT #2 file
+6 ; VALMBCK - 'R' = refresh screen
+7 ;
+8 ;patient lookup array
NEW DGPAT
+9 ;
+10 ;set screen to full scrolling region
+11 DO FULL^VALM1
+12 ;
+13 ;patient selection (lookup)
+14 DO SELPAT^DGPFUT1(.DGPAT)
+15 IF (+$GET(DGPAT)>0)
Begin DoDot:1
+16 SET DGDFN=+DGPAT
+17 ;
+18 if '$$CONTINUE^DGPFUT()
QUIT
+19 ;
+20 ;- build header for selected patient
+21 DO BLDHDR^DGPFLMU(DGDFN,.VALMHDR)
+22 ;
+23 ;- build list of flag assignments for selected patient
+24 DO BLDLIST^DGPFLMU(DGDFN)
End DoDot:1
+25 ;
+26 ;return to LM (refresh screen)
+27 SET VALMBCK="R"
+28 QUIT
+29 ;
+30 ;
DF ;Entry point for DGPF DISPLAY ASSIGNMENT DETAIL action protocol.
+1 ;
+2 ; Input: None
+3 ;
+4 ; Output:
+5 ; VALMBCK - 'R' = refresh screen
+6 ;
+7 ;patient dfn
NEW DGDFN
+8 ;assignment ien
NEW DGIEN
+9 ;user selection
NEW SEL
+10 ;output of EN^VALM2 call, array of user selected entries
NEW VALMY
+11 ;
+12 ;set screen to full scroll region
+13 DO FULL^VALM1
+14 ;
+15 ;is action selection allowed?
+16 IF '$DATA(@VALMAR@("IDX"))
Begin DoDot:1
+17 WRITE !!?2,">>> '"_$PIECE($GET(XQORNOD(0)),U,3)_"' action not allowed at this point.",*7
+18 IF '$GET(DGDFN)
WRITE !?6,"A patient has not been selected."
+19 IF '$TEST
WRITE !?6,"There are no record flag assignments for this patient."
+20 DO PAUSE^VALM1
+21 SET VALMBCK="R"
End DoDot:1
QUIT
+22 ;
+23 ;ask user to select a single assignment for detail display
+24 SET (SEL,DGIEN,VALMBCK)=""
+25 DO EN^VALM2($GET(XQORNOD(0)),"S")
+26 ;
+27 ;process user selection
+28 SET SEL=$ORDER(VALMY(""))
+29 IF SEL
IF $DATA(@VALMAR@("IDX",SEL,SEL))
Begin DoDot:1
+30 SET DGIEN=$PIECE($GET(@VALMAR@("IDX",SEL,SEL)),U)
+31 SET DGDFN=$PIECE($GET(@VALMAR@("IDX",SEL,SEL)),U,2)
+32 ;-display flag assignment details
+33 NEW VALMHDR
+34 DO EN^DGPFLMAD
End DoDot:1
+35 ;
+36 ;return to LM (refresh screen)
+37 SET VALMBCK="R"
+38 QUIT
