- 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 Jan 18, 2025@03:48:52 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