| [613] | 1 | DGPFLF3 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 6/9/04 2:05pm
|
|---|
| 2 | ;;5.3;Registration;**425,554,650**;Aug 13, 1993 ;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | ;no direct entry
|
|---|
| 5 | QUIT
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | AF ;Entry point for DGPF ADD FLAG action protocol.
|
|---|
| 9 | ;
|
|---|
| 10 | ; Input: DGCAT - flag category (1=National, 2=Local)
|
|---|
| 11 | ;
|
|---|
| 12 | ; Output: New File entry in PRF LOCAL FLAG FILE (#26.11)
|
|---|
| 13 | ; New File entry in PRF LOCAL FLAG HISTORY FILE (#26.12)
|
|---|
| 14 | ; Set variable VALMBCK to 'R' = refresh screen
|
|---|
| 15 | ;
|
|---|
| 16 | N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call
|
|---|
| 17 | N DGASK ;return value from call to ^DIR - $$ANSWER^DGPFUT call
|
|---|
| 18 | N DGCKWP ;check if word-processing is OK
|
|---|
| 19 | N DGPFLF ;array containing flag record field values
|
|---|
| 20 | N DGPFLH ;array containing flag history record field values
|
|---|
| 21 | N DGABORT ;abort flag
|
|---|
| 22 | N DGRESULT ;result of $$STOALL^DGPFALF1 api call
|
|---|
| 23 | N DGRDAY ;review frequency var
|
|---|
| 24 | N DGNDAY ;notification days var
|
|---|
| 25 | N DGERR ;if error returned
|
|---|
| 26 | N DGOK ;ok flag to enter record flag entry & flag description
|
|---|
| 27 | N DGMSG ;user message
|
|---|
| 28 | N DGQ ;quit flag
|
|---|
| 29 | ;
|
|---|
| 30 | ;init vars
|
|---|
| 31 | S DGOK=1,(DGQ,DGABORT)=0
|
|---|
| 32 | ;
|
|---|
| 33 | ;set screen to full scrolling region
|
|---|
| 34 | D FULL^VALM1
|
|---|
| 35 | W !
|
|---|
| 36 | ;
|
|---|
| 37 | ;check flag category (only Category II flags can be created)
|
|---|
| 38 | I DGCAT=1 D
|
|---|
| 39 | . D BLD^DIALOG(261129,"Can not add 'Category I' flags.","","DGERR","F")
|
|---|
| 40 | . D MSG^DIALOG("WE","","","","DGERR") W *7
|
|---|
| 41 | . D PAUSE^VALM1
|
|---|
| 42 | . S DGOK=0
|
|---|
| 43 | ;
|
|---|
| 44 | ;user prompts
|
|---|
| 45 | D:DGOK
|
|---|
| 46 | . ;-- init flag record and history arrays
|
|---|
| 47 | . ; The DGPFLF array will contain 2 "^" pieces (internal^external)
|
|---|
| 48 | . ; for a final full screen display before filing.
|
|---|
| 49 | . K DGPFLF,DGPFLH
|
|---|
| 50 | . ;
|
|---|
| 51 | . ;-- prompt for flag name, quit if one not entered
|
|---|
| 52 | . S DGASK=$$ANSWER^DGPFUT("Enter the Record Flag Name","","26.11,.01^^I $D(^DGPF(26.11,""B"",X)) K X W "" *** Flag name already on file""")
|
|---|
| 53 | . I DGASK=-1!(DGASK=0) S DGABORT=1 Q
|
|---|
| 54 | . S DGPFLF("FLAG")=DGASK_U_DGASK
|
|---|
| 55 | . ;
|
|---|
| 56 | . ;-- prompt for status of the flag, quit if one not entered
|
|---|
| 57 | . S DGASK=$$ANSWER^DGPFUT("Enter the Status of the Flag","ACTIVE","26.11,.02")
|
|---|
| 58 | . I DGASK<0 S DGABORT=1 Q
|
|---|
| 59 | . S DGPFLF("STAT")=DGASK_U_$$EXTERNAL^DILFD(26.11,.02,"F",DGASK)
|
|---|
| 60 | . ;
|
|---|
| 61 | . ;-- prompt for flag type, quit if one not entered
|
|---|
| 62 | . S DGASK=$$ANSWER^DGPFUT("Enter the Type of the Flag","","26.11,.03")
|
|---|
| 63 | . I DGASK'>0 S DGABORT=1 Q
|
|---|
| 64 | . S DGPFLF("TYPE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.03,"F",DGASK)
|
|---|
| 65 | . ;
|
|---|
| 66 | . ;-- prompt for principal investigator(s) name for RESEARCH flag type
|
|---|
| 67 | . I +DGPFLF("TYPE")=2,'$$PRININV^DGPFLF6(0,.DGPFLF) D Q:DGABORT
|
|---|
| 68 | . . I $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1 S DGABORT=1
|
|---|
| 69 | . ;
|
|---|
| 70 | . ;-- prompt for review frequency, quit if user aborts
|
|---|
| 71 | . S DGASK=$$ANSWER^DGPFUT("Enter the Review Frequency Days","","26.11,.04^^K:$L(X)>4!(X[""."") X")
|
|---|
| 72 | . I DGASK<0 S DGABORT=1 Q
|
|---|
| 73 | . S DGPFLF("REVFREQ")=DGASK_U_DGASK
|
|---|
| 74 | . S DGRDAY=DGASK
|
|---|
| 75 | . I DGASK=0 D
|
|---|
| 76 | . . ;-- if review frequency=0, don't ask notification/review group
|
|---|
| 77 | . . ; reset both fields
|
|---|
| 78 | . . S DGPFLF("NOTIDAYS")=0_U_0
|
|---|
| 79 | . . S DGPFLF("REVGRP")=""_U_""
|
|---|
| 80 | . . ;
|
|---|
| 81 | . E D Q:DGABORT ;continue to prompt user and check abort logic
|
|---|
| 82 | . . ;
|
|---|
| 83 | . . ;-- prompt for notification days
|
|---|
| 84 | . . S DGASK=$$ANSWER^DGPFUT("Enter the Notification Days","","26.11,.05^^K:$L(X)>4!(X[""."")!(X>DGRDAY) X")
|
|---|
| 85 | . . I DGASK<0 S DGABORT=1 Q
|
|---|
| 86 | . . S DGPFLF("NOTIDAYS")=DGASK_U_DGASK
|
|---|
| 87 | . . ;
|
|---|
| 88 | . . S DGQ=0
|
|---|
| 89 | . . F D Q:(DGQ!DGABORT)
|
|---|
| 90 | . . . ;-- prompt for review mail group name, optional entry
|
|---|
| 91 | . . . S DGASK=$$ANSWER^DGPFUT("Enter the Review Mail Group","","26.11,.06")
|
|---|
| 92 | . . . I DGASK<0 S DGABORT=1 Q
|
|---|
| 93 | . . . I DGASK'>0 D Q
|
|---|
| 94 | . . . . W !," >>> You've entered the Review Frequency and Notification Days,"
|
|---|
| 95 | . . . . W !," now enter a Review Mail Group or abort this process.",*7
|
|---|
| 96 | . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
|
|---|
| 97 | . . . ;
|
|---|
| 98 | . . . S DGPFLF("REVGRP")=DGASK_U_$$EXTERNAL^DILFD(26.11,.06,"F",DGASK)
|
|---|
| 99 | . . . S DGQ=1 ;set entry, quit
|
|---|
| 100 | . ;
|
|---|
| 101 | . ;-- prompt for associated TIU PN Title, quit if one not entered
|
|---|
| 102 | . ; There is a DD screen on the (#.07) field - using IA #4380
|
|---|
| 103 | . ; to only display Category II PN Titles not already associated
|
|---|
| 104 | . ; with a Category II (Local) Record Flag name.
|
|---|
| 105 | . ;
|
|---|
| 106 | . S DGASK=$$ANSWER^DGPFUT("Enter the Progress Note Title","","26.11,.07")
|
|---|
| 107 | . I DGASK<0 S DGABORT=1 Q
|
|---|
| 108 | . S DGPFLF("TIUTITLE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.07,"F",DGASK)
|
|---|
| 109 | . ;
|
|---|
| 110 | . ;-- have user enter flag description text (required)
|
|---|
| 111 | . S DGCKWP=0
|
|---|
| 112 | . S DGWPROOT=$NA(^TMP($J,"DGPFDESC"))
|
|---|
| 113 | . K @DGWPROOT
|
|---|
| 114 | . F D Q:(DGCKWP!DGABORT)
|
|---|
| 115 | . . W !,"Enter the description for this new record flag:" ;needed for line editor
|
|---|
| 116 | . . S DIC=$$OREF^DILF(DGWPROOT)
|
|---|
| 117 | . . S DIWETXT="Patient Record Flag - Flag Description Text"
|
|---|
| 118 | . . S DIWESUB="Flag Description Text"
|
|---|
| 119 | . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
|
|---|
| 120 | . . S DWPK=1 ;if line editor, don't join line
|
|---|
| 121 | . . D EN^DIWE
|
|---|
| 122 | . . I $$CKWP^DGPFUT(DGWPROOT) S DGCKWP=1 Q
|
|---|
| 123 | . . W !,"Flag Description Text is required!",!,*7
|
|---|
| 124 | . . I '$$CONTINUE^DGPFUT() S DGABORT=1
|
|---|
| 125 | . ;
|
|---|
| 126 | . ;-- quit if required flag description not entered
|
|---|
| 127 | . Q:DGABORT
|
|---|
| 128 | . ;
|
|---|
| 129 | . ;-- place flag description text into assignment array
|
|---|
| 130 | . M DGPFLF("DESC")=@DGWPROOT K @DGWPROOT
|
|---|
| 131 | . ;
|
|---|
| 132 | . ;-- setup remaining flag history array nodes for filing
|
|---|
| 133 | . ; note, the DGPFLH("FLAG") will be setup in $$STOALL^DGPFALF1
|
|---|
| 134 | . S DGPFLH("ENTERDT")=$$NOW^XLFDT() ;current date/time
|
|---|
| 135 | . S DGPFLH("ENTERBY")=DUZ ;current user
|
|---|
| 136 | . S DGPFLH("REASON",1,0)="New Local Patient Record Flag entered."
|
|---|
| 137 | . ;
|
|---|
| 138 | . ;-- re-display user's answers on full screen
|
|---|
| 139 | . D REVIEW^DGPFUT3(.DGPFLF,.DGPFLH,"",XQY0,XQORNOD(0))
|
|---|
| 140 | . ;
|
|---|
| 141 | . W !,*7
|
|---|
| 142 | . I $$ANSWER^DGPFUT("Would you like to file this new local record flag","YES","Y")'>0 S DGABORT=1 Q
|
|---|
| 143 | . ;
|
|---|
| 144 | . W !,"Filing the new local record flag..."
|
|---|
| 145 | . ;
|
|---|
| 146 | . ;-- file both the (#26.11) & (#26.12) entries
|
|---|
| 147 | . S DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR)
|
|---|
| 148 | . ;
|
|---|
| 149 | . W !!," >>> Local record flag was "_$S(+DGRESULT:"filed successfully.",1:"not filed successfully."),*7
|
|---|
| 150 | . ;
|
|---|
| 151 | . D PAUSE^VALM1
|
|---|
| 152 | ;
|
|---|
| 153 | I DGABORT D
|
|---|
| 154 | . W !," >>> The '"_$P($G(XQORNOD(0)),U,3)_"' action is aborting, nothing has been filed.",*7
|
|---|
| 155 | . I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") ;pause
|
|---|
| 156 | ;
|
|---|
| 157 | ;re-build list of local record flags
|
|---|
| 158 | D BLD^DGPFLF
|
|---|
| 159 | ;
|
|---|
| 160 | ;return to LM (refresh screen)
|
|---|
| 161 | S VALMBCK="R"
|
|---|
| 162 | Q
|
|---|
