Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSPOS1

ACHSPOS1.m

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