ACHSPOS1 ; IHS/ITSC/PMF - DEFERRED SERVICE LETTER FORCE ENTRY DENIAL STATUS FORCE ENTRY ; [ 10/19/2001 10:58 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
;ACHS*3.1*18 7/16/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
;
S $ZT="ERROR^"_$ZN
S %H=$H D YX^%DTC S NOW=Y
S ^ACHSINST(ACHSVERS,$ZN,"ENTERED")=NOW
;
N A,B,C
F A=1:2 S B=$P($T(TAG+A),";;",2) Q:B="" S @B=$P($T(TAG+(A+1)),";;",2)
;
D DEF ;ENTER 'DEFERRED SERVICE LETTER' DATA
D DENA ;ENTER 'DENIAL STATUS' DATA
;
S %H=$H D YX^%DTC S NOW=Y
S ^ACHSINST(ACHSVERS,$ZN,"FINISHED")=NOW
Q
;
;
DEF ;CODE FOR FORCE ENTRY TO ^ACHSDFC HERE
;
W !!
;
;
;
;{ABK,7/16/2010}I '$D(^ACHSDEF(0)) S ^ACHSDEF(0)="CHS DEFERRED SERVICE DATA^9002066P^0^0"
I '$D(^ACHSDEF(0)) S ^ACHSDEF(0)="CHS UNMET NEED DATA^9002066P^0^0"
;
;
S XBCFIXFL=9002066
D XBCFIXFL^XBCFIX
;
I XBCFIXC D Q
.S %H=$H D YX^%DTC S NOW=Y
.;S ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"CHS DEFERRED SERVICE DATA FOUND")=NOW
.;W !?15,"'CHS DEFERRED SERVICE' data found! Not overwriting!"
.S ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"CHS UNMET NEED DATA FOUND")=NOW
.W !?15,"'CHS UNMET NEED' data found! Not overwriting!"
E D
.;W !?15,"'CHS DEFERRED SERVICE' data not found! Loading data....."
.;S ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"CHS DEFERRED SERVICE DATA NOT FOUND")=NOW
.W !?15,"'CHS DEFERRED SERVICE' data not found! Loading data....."
.S ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"CHS DEFERRED SERVICE DATA NOT FOUND")=NOW
;
;get each facility listed in the CHS facility file and
;set up the deferred global
S %H=$H D YX^%DTC S NOW=Y
S ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"ENTERED")=NOW
;
S ACHSFAC=""
F S ACHSFAC=$O(^ACHSF("B",ACHSFAC)) Q:ACHSFAC="" D DEFFAC
;
Q
;
DEFFAC ;
S X="^TMP("_$J_",""DEF"")"
F S X=$Q(@X) Q:X=""!(X'[("""DEF""")) D
.S GLOBAL="^ACHSDEF("_ACHSFAC_$P(X,"""DEF""",2)
.S @GLOBAL=@X
S DIK="^ACHSDEF(" D IXALL^DIK
;
S %H=$H D YX^%DTC S NOW=Y
S ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"FINISHED")=NOW
Q
;
DENA ;CODE FOR ENTRY TO ^ACHSDENA
;
S %H=$H D YX^%DTC S NOW=Y
S ^ACHSINST(ACHSVERS,"DENA^"_$ZN,"ENTERED")=NOW
;
I '$D(^ACHSDENA(0)) S ^ACHSDENA(0)="CHS DENIAL STATUS^9002074^0^0"
S XBCFIXFL=9002074
D XBCFIXFL^XBCFIX
;
;IF FILE HAS ENTRIES LEAVE ALONE AND QUIT
I XBCFIXC D Q
.S %H=$H D YX^%DTC S NOW=Y
.S ^ACHSINST(ACHSVERS,"DENA^"_$ZN,"CHS DENIAL STATUS DATA FOUND")=NOW
.W !?15,"'CHS DENIAL STATUS' data found! Not overwriting!'"
E D
.W !?15,"'CHS DENIAL STATUS' data not found! Loading data...."
.S ^ACHSINST(ACHSVERS,"DENA^"_$ZN,"CHS DENIAL STATUS DATA NOT FOUND")=NOW
;
S X="^TMP("_$J_",""STA"")"
F S X=$Q(@X) Q:X=""!(X'[("""STA""")) D
.S GLOBAL="^ACHSDENA("_$P($P(X,"""STA""",2),",",2,99)
.S @GLOBAL=@X
S DIK="^ACHSDENA(" D IXALL^DIK
;
S %H=$H D YX^%DTC S NOW=Y
S ^ACHSINST(ACHSVERS,"DENA^"_$ZN,"FINISHED")=NOW
;
Q
;
ERROR S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"ERROR TRAP CALLED")=NOW
G ^%ET
Q
;
;
TAG ;
;;^TMP($J,"DEF",2,0)
;;^^12^12^2940809
;;^TMP($J,"DEF",2,1,0)
;;An Indian Health Service (IHS) physician has recommended that you have
;;^TMP($J,"DEF",2,2,0)
;;the deferred service identified above. Funds are not presently
;;^TMP($J,"DEF",2,3,0)
;;available for payment for deferred services. This is to notify you
;;^TMP($J,"DEF",2,4,0)
;;that your name has been put on the waiting list for scheduling and
;;^TMP($J,"DEF",2,5,0)
;;payment if funding becomes available.
;;^TMP($J,"DEF",2,6,0)
;;
;;^TMP($J,"DEF",2,7,0)
;;If you have not been notified of the availability of funds within six to twelve months of the
;;^TMP($J,"DEF",2,8,0)
;;date of this letter, contact this office for further information. In the meantime, please
;;^TMP($J,"DEF",2,9,0)
;;contact your health care providers for any concerns about your medical condition.
;;^TMP($J,"DEF",2,10,0)
;;
;;^TMP($J,"DEF",2,11,0)
;;While your request for deferred services funds is pending, you may
;;^TMP($J,"DEF",2,12,0)
;;appeal this decision to:
;;^TMP($J,"STA",1,0)
;;PAYED WITH ADDITIONAL MONEY
;;^TMP($J,"STA",2,0)
;;REVERSED AFTER APPEAL
;;^TMP($J,"STA",3,0)
;;UPHELD AFTER APPEAL
;;^TMP($J,"STA",4,0)
;;APPEAL PENDING
ACHSPOS1 ; IHS/ITSC/PMF - DEFERRED SERVICE LETTER FORCE ENTRY DENIAL STATUS FORCE ENTRY ; [ 10/19/2001 10:58 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
+2 ;ACHS*3.1*18 7/16/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
+3 ;
+4 SET $ZT="ERROR^"_$ZN
+5 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+6 SET ^ACHSINST(ACHSVERS,$ZN,"ENTERED")=NOW
+7 ;
+8 NEW A,B,C
+9 FOR A=1:2
SET B=$PIECE($TEXT(TAG+A),";;",2)
IF B=""
QUIT
SET @B=$PIECE($TEXT(TAG+(A+1)),";;",2)
+10 ;
+11 ;ENTER 'DEFERRED SERVICE LETTER' DATA
DO DEF
+12 ;ENTER 'DENIAL STATUS' DATA
DO DENA
+13 ;
+14 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+15 SET ^ACHSINST(ACHSVERS,$ZN,"FINISHED")=NOW
+16 QUIT
+17 ;
+18 ;
DEF ;CODE FOR FORCE ENTRY TO ^ACHSDFC HERE
+1 ;
+2 WRITE !!
+3 ;
+4 ;
+5 ;
+6 ;{ABK,7/16/2010}I '$D(^ACHSDEF(0)) S ^ACHSDEF(0)="CHS DEFERRED SERVICE DATA^9002066P^0^0"
+7 IF '$DATA(^ACHSDEF(0))
SET ^ACHSDEF(0)="CHS UNMET NEED DATA^9002066P^0^0"
+8 ;
+9 ;
+10 SET XBCFIXFL=9002066
+11 DO XBCFIXFL^XBCFIX
+12 ;
+13 IF XBCFIXC
Begin DoDot:1
+14 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+15 ;S ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"CHS DEFERRED SERVICE DATA FOUND")=NOW
+16 ;W !?15,"'CHS DEFERRED SERVICE' data found! Not overwriting!"
+17 SET ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"CHS UNMET NEED DATA FOUND")=NOW
+18 WRITE !?15,"'CHS UNMET NEED' data found! Not overwriting!"
End DoDot:1
QUIT
+19 IF '$TEST
Begin DoDot:1
+20 ;W !?15,"'CHS DEFERRED SERVICE' data not found! Loading data....."
+21 ;S ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"CHS DEFERRED SERVICE DATA NOT FOUND")=NOW
+22 WRITE !?15,"'CHS DEFERRED SERVICE' data not found! Loading data....."
+23 SET ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"CHS DEFERRED SERVICE DATA NOT FOUND")=NOW
End DoDot:1
+24 ;
+25 ;get each facility listed in the CHS facility file and
+26 ;set up the deferred global
+27 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+28 SET ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"ENTERED")=NOW
+29 ;
+30 SET ACHSFAC=""
+31 FOR
SET ACHSFAC=$ORDER(^ACHSF("B",ACHSFAC))
IF ACHSFAC=""
QUIT
DO DEFFAC
+32 ;
+33 QUIT
+34 ;
DEFFAC ;
+1 SET X="^TMP("_$JOB_",""DEF"")"
+2 FOR
SET X=$QUERY(@X)
IF X=""!(X'[("""DEF"""))
QUIT
Begin DoDot:1
+3 SET GLOBAL="^ACHSDEF("_ACHSFAC_$PIECE(X,"""DEF""",2)
+4 SET @GLOBAL=@X
End DoDot:1
+5 SET DIK="^ACHSDEF("
DO IXALL^DIK
+6 ;
+7 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+8 SET ^ACHSINST(ACHSVERS,"DEF^"_$ZN,"FINISHED")=NOW
+9 QUIT
+10 ;
DENA ;CODE FOR ENTRY TO ^ACHSDENA
+1 ;
+2 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+3 SET ^ACHSINST(ACHSVERS,"DENA^"_$ZN,"ENTERED")=NOW
+4 ;
+5 IF '$DATA(^ACHSDENA(0))
SET ^ACHSDENA(0)="CHS DENIAL STATUS^9002074^0^0"
+6 SET XBCFIXFL=9002074
+7 DO XBCFIXFL^XBCFIX
+8 ;
+9 ;IF FILE HAS ENTRIES LEAVE ALONE AND QUIT
+10 IF XBCFIXC
Begin DoDot:1
+11 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+12 SET ^ACHSINST(ACHSVERS,"DENA^"_$ZN,"CHS DENIAL STATUS DATA FOUND")=NOW
+13 WRITE !?15,"'CHS DENIAL STATUS' data found! Not overwriting!'"
End DoDot:1
QUIT
+14 IF '$TEST
Begin DoDot:1
+15 WRITE !?15,"'CHS DENIAL STATUS' data not found! Loading data...."
+16 SET ^ACHSINST(ACHSVERS,"DENA^"_$ZN,"CHS DENIAL STATUS DATA NOT FOUND")=NOW
End DoDot:1
+17 ;
+18 SET X="^TMP("_$JOB_",""STA"")"
+19 FOR
SET X=$QUERY(@X)
IF X=""!(X'[("""STA"""))
QUIT
Begin DoDot:1
+20 SET GLOBAL="^ACHSDENA("_$PIECE($PIECE(X,"""STA""",2),",",2,99)
+21 SET @GLOBAL=@X
End DoDot:1
+22 SET DIK="^ACHSDENA("
DO IXALL^DIK
+23 ;
+24 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+25 SET ^ACHSINST(ACHSVERS,"DENA^"_$ZN,"FINISHED")=NOW
+26 ;
+27 QUIT
+28 ;
ERROR SET ^ACHSINST(ACHSVERS,"ERROR",$ZN,"ERROR TRAP CALLED")=NOW
+1 GOTO ^%ET
+2 QUIT
+3 ;
+4 ;
TAG ;
+1 ;;^TMP($J,"DEF",2,0)
+2 ;;^^12^12^2940809
+3 ;;^TMP($J,"DEF",2,1,0)
+4 ;;An Indian Health Service (IHS) physician has recommended that you have
+5 ;;^TMP($J,"DEF",2,2,0)
+6 ;;the deferred service identified above. Funds are not presently
+7 ;;^TMP($J,"DEF",2,3,0)
+8 ;;available for payment for deferred services. This is to notify you
+9 ;;^TMP($J,"DEF",2,4,0)
+10 ;;that your name has been put on the waiting list for scheduling and
+11 ;;^TMP($J,"DEF",2,5,0)
+12 ;;payment if funding becomes available.
+13 ;;^TMP($J,"DEF",2,6,0)
+14 ;;
+15 ;;^TMP($J,"DEF",2,7,0)
+16 ;;If you have not been notified of the availability of funds within six to twelve months of the
+17 ;;^TMP($J,"DEF",2,8,0)
+18 ;;date of this letter, contact this office for further information. In the meantime, please
+19 ;;^TMP($J,"DEF",2,9,0)
+20 ;;contact your health care providers for any concerns about your medical condition.
+21 ;;^TMP($J,"DEF",2,10,0)
+22 ;;
+23 ;;^TMP($J,"DEF",2,11,0)
+24 ;;While your request for deferred services funds is pending, you may
+25 ;;^TMP($J,"DEF",2,12,0)
+26 ;;appeal this decision to:
+27 ;;^TMP($J,"STA",1,0)
+28 ;;PAYED WITH ADDITIONAL MONEY
+29 ;;^TMP($J,"STA",2,0)
+30 ;;REVERSED AFTER APPEAL
+31 ;;^TMP($J,"STA",3,0)
+32 ;;UPHELD AFTER APPEAL
+33 ;;^TMP($J,"STA",4,0)
+34 ;;APPEAL PENDING
