- 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