| 1 | ORWDBA8 ; SLC/GDU - Billing Awareness - Phase I [11/16/04 15:39]
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195**;Dec 17, 1997
|
|---|
| 3 | ;Clinical Indicator Data Capture By Provider Parameter Management
|
|---|
| 4 | ;
|
|---|
| 5 | ;Varaibles
|
|---|
| 6 | ; CIDC Clinical Indicator Data Capture Parameter, current value
|
|---|
| 7 | ; CNT Counter, incremented counter variable
|
|---|
| 8 | ; DIR Input array variable for ^DIR
|
|---|
| 9 | ; DT Standard Fileman/Kernel variable for current date
|
|---|
| 10 | ; DT is set, but not newed or killed
|
|---|
| 11 | ; DTOUT Timeout indicator, output variable of ^DIR
|
|---|
| 12 | ; DUOUT Up arrow indicator, output variable of ^DIR
|
|---|
| 13 | ; OREM Error Message, output variable of ^DIC, and ^XPAR
|
|---|
| 14 | ; FST First, display control varible
|
|---|
| 15 | ; HC Help Counter, help text line count
|
|---|
| 16 | ; IEN Internal Entry Number
|
|---|
| 17 | ; IOF Standard Kernel variable to clear screen
|
|---|
| 18 | ; NAME Provider Name, parsed from RF output array from FIND^DIC
|
|---|
| 19 | ; NX0 Next group of providers prompt, used to help build DIR(0)
|
|---|
| 20 | ; NXC Next group of providers count, used to help build DIR(0)
|
|---|
| 21 | ; NXH Next group of providers help, used to help build DIR("?"
|
|---|
| 22 | ; PTD Provider Termination Date, internal value
|
|---|
| 23 | ; RF Records Found, initial user search results
|
|---|
| 24 | ; ORSCR Screen, input variable to filter search
|
|---|
| 25 | ; SP Selected Provider
|
|---|
| 26 | ; SV Search Value
|
|---|
| 27 | ; U Standard FileMan, Kernel field delimiter
|
|---|
| 28 | ; US User Selection
|
|---|
| 29 | ; WA Work Array, filtered array of providers for user selection
|
|---|
| 30 | ; X Standard FileMan work varaible
|
|---|
| 31 | ; Y Processed output of user selection, output variable of ^DIR
|
|---|
| 32 | ;
|
|---|
| 33 | ;External References
|
|---|
| 34 | ; FIND^DIC DBIA 2051, FileMan record(s) finder
|
|---|
| 35 | ; ^DIR DBIA 10026, FileMan input reader
|
|---|
| 36 | ; $$GET^XPAR DBIA 2263, Get current value of single parameter
|
|---|
| 37 | ; ADD^XPAR DBIA 2263, Add new parameter
|
|---|
| 38 | ; CHG^XPAR DBIA 2263, Change current value of parameter
|
|---|
| 39 | ; $$DT^XLFDT DBIA 10103, Gets today's date from the system
|
|---|
| 40 | ;
|
|---|
| 41 | EN ;Starting point of this program
|
|---|
| 42 | ;Ask user for provider
|
|---|
| 43 | N APS,CIDC,CNT,DIR,DTOUT,DUOUT,OREM,FST,HC,IEN,NAME,NX0,NXC,NXH,RF
|
|---|
| 44 | N ORSCR,PTD,SP,SV,US,VAL,WA,X,Y
|
|---|
| 45 | S DT=$$DT^XLFDT
|
|---|
| 46 | S DIR(0)=$P($T(FT0),";",3)
|
|---|
| 47 | S DIR("A")=$P($T(FA),";",3)
|
|---|
| 48 | S DIR("?",1)=$P($T(FH1),";",3)
|
|---|
| 49 | S DIR("?",2)=$P($T(FH2),";",3)
|
|---|
| 50 | S DIR("?")=$P($T(FH3),";",3)
|
|---|
| 51 | D SCRHDR W ! D ^DIR S SV=Y K DIR
|
|---|
| 52 | I SV=""!($D(DTOUT))!($D(DUOUT)) G EXIT
|
|---|
| 53 | S ORSCR="I $D(^XUSEC(""PROVIDER"",Y))=1"
|
|---|
| 54 | D FIND^DIC(200,"","@;.01;7;9.2I;9.2","CP",SV,"*","",.ORSCR,"","RF","OREM")
|
|---|
| 55 | ;Test if no matching records found. If true alert user.
|
|---|
| 56 | I $P(RF("DILIST",0),U)=0 D G:Y=1 EN G EXIT
|
|---|
| 57 | . S DIR(0)="E"
|
|---|
| 58 | . S DIR("A",1)=$P($T(UAA1),";",3)_" "_SV
|
|---|
| 59 | . S DIR("A")=$P($T(UAA5),";",3)
|
|---|
| 60 | . D SCRHDR W ! D ^DIR K DIR
|
|---|
| 61 | S (SP,PTD)=""
|
|---|
| 62 | ;If search returns only 1 match
|
|---|
| 63 | I $P(RF("DILIST",0),U)=1 D
|
|---|
| 64 | . S SP=1,PTD=$P(RF("DILIST",SP,0),U,4)
|
|---|
| 65 | .;Test if provider is DISUSERED. If true alert user and quit
|
|---|
| 66 | . I $P(RF("DILIST",SP,0),U,3)="YES" D Q
|
|---|
| 67 | .. S DIR(0)="E"
|
|---|
| 68 | .. S DIR("A",1)=$P(RF("DILIST",SP,0),U,2)_" "_$P($T(UAA2),";",3)
|
|---|
| 69 | .. S DIR("A")=$P($T(UAA5),";",3)
|
|---|
| 70 | .. D SCRHDR W ! D ^DIR K DIR
|
|---|
| 71 | .. S SP=$S(Y=1:"",1:"Q")
|
|---|
| 72 | .;Test if provider is terminated. If true alert user and quit
|
|---|
| 73 | . I PTD'="",(PTD=DT)!(PTD<DT) D Q
|
|---|
| 74 | .. S DIR(0)="E"
|
|---|
| 75 | .. S DIR("A",1)=$P(RF("DILIST",SP,0),U,2)_" "_$P($T(UAA3),";",3)
|
|---|
| 76 | .. S DIR("A",1)=DIR("A",1)_" "_$P(RF("DILIST",SP,0),U,5)
|
|---|
| 77 | .. S DIR("A")=$P($T(UAA5),";",3)
|
|---|
| 78 | .. D SCRHDR W ! D ^DIR K DIR
|
|---|
| 79 | .. S SP=$S(Y=1:"",1:"Q")
|
|---|
| 80 | . S IEN=$P(RF("DILIST",1,0),U)
|
|---|
| 81 | . S NAME=$P(RF("DILIST",1,0),U,2)
|
|---|
| 82 | I $P(RF("DILIST",0),U)>1 D
|
|---|
| 83 | . S WA(0)=0
|
|---|
| 84 | . F X=1:1:$P(RF("DILIST",0),U) D
|
|---|
| 85 | .. S PTD=$P(RF("DILIST",X,0),U,4)
|
|---|
| 86 | .. I $P(RF("DILIST",X,0),U,3)="",(PTD="")!(PTD>DT) D
|
|---|
| 87 | ... S WA(0)=WA(0)+1
|
|---|
| 88 | ... S WA(WA(0))=RF("DILIST",X,0)
|
|---|
| 89 | . I WA(0)=0 D
|
|---|
| 90 | .. ;Alerting the user that this search failed because all providers
|
|---|
| 91 | .. ;returned are inactive
|
|---|
| 92 | .. S DIR(0)="E"
|
|---|
| 93 | .. S DIR("A",1)=$P($T(UAA4),";",3)_" "_SV
|
|---|
| 94 | .. S DIR("A")=$P($T(UAA5),";",3)
|
|---|
| 95 | .. D SCRHDR W ! D ^DIR K DIR
|
|---|
| 96 | .. S SP=$S(Y=1:"",1:"Q")
|
|---|
| 97 | . I WA(0)=0 Q
|
|---|
| 98 | . I WA(0)=1 S SP=1 ;Default to the single active provider
|
|---|
| 99 | . I WA(0)>1 D SPFL ;Additional selection if several active providers
|
|---|
| 100 | . I SP="Q"!(SP="") Q
|
|---|
| 101 | . S IEN=$P(WA(SP),U)
|
|---|
| 102 | . S NAME=$P(WA(SP),U,2)
|
|---|
| 103 | I SP="Q" G EXIT
|
|---|
| 104 | I SP="" G EN
|
|---|
| 105 | D PSP G EN
|
|---|
| 106 | EXIT ;Exit point for this program
|
|---|
| 107 | Q
|
|---|
| 108 | FT0 ;;FO^1:40
|
|---|
| 109 | FA ;;Select the provider to manage the parameter
|
|---|
| 110 | FH1 ;;Enter the name/partial name of the provider.
|
|---|
| 111 | FH2 ;;This is free text, 1 to 40 characters in length.
|
|---|
| 112 | FH3 ;;This search will only return those with the PROVIDER key.
|
|---|
| 113 | UAA1 ;;Found no provider records matching the search criteria of
|
|---|
| 114 | UAA2 ;;is a provider who has been DISUSERED.
|
|---|
| 115 | UAA3 ;;is an inactive provider with a termination date of
|
|---|
| 116 | UAA4 ;;Found no active provider records matching the search criteria of
|
|---|
| 117 | UAA5 ;;Hit enter to continue or "^" to quit
|
|---|
| 118 | SPFL ;Select Provider From List
|
|---|
| 119 | I $D(FST)=0 S FST=1
|
|---|
| 120 | S DIR(0)="SO^"
|
|---|
| 121 | S DIR("?",1)=$P($T(DH),";",3)
|
|---|
| 122 | S DIR("?")=$P($T(DHS),";",3)
|
|---|
| 123 | S DIR("A")=$P($T(DA),";",3)
|
|---|
| 124 | I WA(0)<10 D
|
|---|
| 125 | . F X=1:1:WA(0) S DIR(0)=DIR(0)_X_":"_$P(WA(X),U,2)_";"
|
|---|
| 126 | I WA(0)=10 D
|
|---|
| 127 | . F X=1:1:10 S DIR(0)=DIR(0)_X_":"_$P(WA(X),U,2)_";"
|
|---|
| 128 | I WA(0)>10 D
|
|---|
| 129 | . S CNT=0,HC=1,(NXC,NX0,NXH,SP,X,Y)=""
|
|---|
| 130 | . F X=FST:1:10+(FST-1) Q:$D(WA(X))=0 D
|
|---|
| 131 | .. S CNT=CNT+1
|
|---|
| 132 | .. S DIR(0)=DIR(0)_X_":"_$P(WA(X),U,2)_";"
|
|---|
| 133 | . S NXC=WA(0)-X,NXC=$S(NXC>10:10,1:NXC)
|
|---|
| 134 | . S NX0=$P($P($T(D0N),";",3),"|")_NXC_$P($P($T(D0N),";",3),"|",2)
|
|---|
| 135 | . S NXH=$P($P($T(DHN),";",3),"|")_NXC_$P($P($T(DHN),";",3),"|",2)
|
|---|
| 136 | . I CNT=10 D
|
|---|
| 137 | .. S DIR(0)=DIR(0)_";"_NX0
|
|---|
| 138 | .. S HC=HC+1,DIR("?",HC)=NXH
|
|---|
| 139 | . I FST>10 D
|
|---|
| 140 | .. S DIR(0)=DIR(0)_";"_$P($T(D0P),";",3)
|
|---|
| 141 | .. S HC=HC+1,DIR("?",HC)=$P($T(DHP),";",3)
|
|---|
| 142 | D SCRHDR,^DIR K DIR
|
|---|
| 143 | S SP=Y
|
|---|
| 144 | I SP="" Q
|
|---|
| 145 | I $D(DTOUT)!($D(DUOUT)) S SP="Q" Q
|
|---|
| 146 | I SP="N"!(SP="P") S FST=$S(SP="N":FST+10,1:FST-10) G SPFL
|
|---|
| 147 | I SP=""!(SP="Q") Q
|
|---|
| 148 | Q
|
|---|
| 149 | D0N ;;N:Next | provider(s)
|
|---|
| 150 | D0P ;;P:Previous 10 providers
|
|---|
| 151 | DH ;;Select the provider for parameter management.
|
|---|
| 152 | DHN ;;Enter N to get the next | providers.
|
|---|
| 153 | DHP ;;Enter P to get the previous 10 providers.
|
|---|
| 154 | DHS ;;Enter "^" to exit or the Enter key to return to provider lookup.
|
|---|
| 155 | DA ;;Select the provider to assign the parameter
|
|---|
| 156 | PSP ;Process Selected Provider
|
|---|
| 157 | S CIDC=$$GET^XPAR(IEN_";VA(200,","OR BILLING AWARENESS BY USER",1,"Q")
|
|---|
| 158 | I CIDC="" D
|
|---|
| 159 | . ;Assign the CIDC parameter and enable/disable it
|
|---|
| 160 | . S DIR(0)="SO^"_$P($T(AE),";",3)_";"_$P($T(AD),";",3)
|
|---|
| 161 | . S DIR("A")=$P($T(AA),";",3)
|
|---|
| 162 | . S DIR("?",1)=$P($T(AHE),";",3),DIR("?")=$P($T(AHD),";",3)
|
|---|
| 163 | . D SCRHDR
|
|---|
| 164 | . W !,$P($T(ASH1),";",3)," ",NAME,!,$P($T(ASH2),";",3)
|
|---|
| 165 | . D ^DIR S US=Y K DIR
|
|---|
| 166 | . I US=""!($D(DTOUT))!($D(DUOUT)) Q
|
|---|
| 167 | . S VAL=$S(US="E":1,1:0),OREM=""
|
|---|
| 168 | . D ADD^XPAR(IEN_";VA(200,","OR BILLING AWARENESS BY USER",1,VAL,.OREM)
|
|---|
| 169 | E D
|
|---|
| 170 | . ;Edit the CIDC parameter to enable or disable it
|
|---|
| 171 | . S DIR(0)="Y"
|
|---|
| 172 | . I CIDC=0 S DIR("A")=$P($T(EEA),";",3),DIR("?",1)=$P($T(EHEY),";",3)
|
|---|
| 173 | . E S DIR("A")=$P($T(EDA),";",3),DIR("?",1)=$P($T(EHDY),";",3)
|
|---|
| 174 | . S DIR("B")="YES",DIR("?")=$P($T(EHN),";",3)
|
|---|
| 175 | . D SCRHDR
|
|---|
| 176 | . W !,$P($T(ESH),";",3)_" "_NAME
|
|---|
| 177 | . W:CIDC=0 !,$P($T(EESH),";",3)
|
|---|
| 178 | . W:CIDC=1 !,$P($T(EDSH),";",3)
|
|---|
| 179 | . W ! D ^DIR S US=Y K DIR
|
|---|
| 180 | . I US=""!(US=0)!($D(DTOUT))!($D(DUOUT)) Q
|
|---|
| 181 | . S OREM="",VAL=$S(CIDC=0:1,1:0)
|
|---|
| 182 | . D CHG^XPAR(IEN_";VA(200,","OR BILLING AWARENESS BY USER",1,VAL,.OREM)
|
|---|
| 183 | Q
|
|---|
| 184 | ASH1 ;;Assign CIDC Functionality Parameter to
|
|---|
| 185 | ASH2 ;;Enable / Disable CIDC Functionality
|
|---|
| 186 | AE ;;E:Enable CIDC functionality
|
|---|
| 187 | AD ;;D:Disable CIDC functionality
|
|---|
| 188 | AA ;;Assign the parameter and enable / disable CIDC functionality
|
|---|
| 189 | AHE ;;Enter E to assign the parameter and enable CIDC for this provider.
|
|---|
| 190 | AHD ;;Enter D to assign the parameter and disable CIDC for this provider
|
|---|
| 191 | ESH ;;Edit Assigned CIDC Functionality Parameter of
|
|---|
| 192 | EESH ;;CIDC Functionality for this provider is currently DISABLED
|
|---|
| 193 | EDSH ;;CIDC Functionality for this provider is currently ENABLED
|
|---|
| 194 | EEA ;;Enable CIDC Functionality (YES/NO)
|
|---|
| 195 | EDA ;;Disable CIDC Functionality (YES/NO)
|
|---|
| 196 | EHEY ;;Enter YES to ENABLE CIDC Functionality
|
|---|
| 197 | EHDY ;;Enter YES to DISABLE CIDC Functionality
|
|---|
| 198 | EHN ;;Enter NO to leave CIDC Functionality unchanged
|
|---|
| 199 | ;
|
|---|
| 200 | SCRHDR ;Screen Header
|
|---|
| 201 | W:$D(IOF) @IOF
|
|---|
| 202 | W !,$P($T(SH1),";",3)
|
|---|
| 203 | Q
|
|---|
| 204 | SH1 ;;Clinical Indicator Data Capture By Provider Parameter Management
|
|---|
