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

ACHSDFI.m

Go to the documentation of this file. 
  1. ACHSDFI ; IHS/ITSC/PMF - DEFERRED SERVICES LIST BY ISSUE DATE ;7/27/10  16:09
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
  1.  ;ACHS*3.1*18 4/1/2010;IHS/OIT/ABK;Change every occurrance of Deferred to Unmet Need
  1.  ;
  1.  K X2,X3
  1. A2 ; --- All or date range
  1.  ;{ABK, 3/31/10}S %=$$DIR^ACHS("Y","ALL DEFERRED SERVICES","YES","Enter 'NO' to select the date range for the denial list","",2)
  1.  S %=$$DIR^ACHS("Y","ALL UNMET NEEDS","YES","Enter 'NO' to select the date range for the denial list","",2)
  1.  G K:$D(DUOUT)!$D(DTOUT)
  1.  I % S ACHDBDT=1,ACHDEDT=9999999 G B
  1.  ;
  1. BDT ; --- Beginning date
  1.  ;{ABK, 3/31/10}S ACHDBDT=$$DATE^ACHS("B","DEFERRED SERVICES LIST")
  1.  S ACHDBDT=$$DATE^ACHS("B","UNMET NEEDS LIST")
  1.  G:ACHDBDT<1 A2
  1.  ;
  1. A3 ; --- Ending date
  1.  ;{ABK, 3/31/10}S ACHDEDT=$$DATE^ACHS("E","DEFERRED SERVICES LIST")
  1.  S ACHDEDT=$$DATE^ACHS("E","UNMET NEEDS LIST")
  1.  G:ACHDEDT<1 BDT
  1.  I $$EBB^ACHS(ACHDBDT,ACHDEDT) G BDT
  1. B ;
  1.  S ACHDHAT=""
  1. DEV ;
  1.  S %ZIS="OPQ"
  1.  D ^%ZIS
  1.  I POP D HOME^%ZIS G K
  1.  G:'$D(IO("Q")) START
  1.  K IO("Q")
  1.  I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
  1.  ;{ABK, 3/31/10}S ZTRTN="START^ACHSDNI",ZTDESC="CHS Deferred Services Documents"_$$FMTE^XLFDT(ACHDBDT)_" to "_$$FMTE^XLFDT(ACHDEDT)
  1.  S ZTRTN="START^ACHSDNI",ZTDESC="CHS Unmet Needs Documents"_$$FMTE^XLFDT(ACHDBDT)_" to "_$$FMTE^XLFDT(ACHDEDT)
  1.  F %="ACHDBDT","ACHDEDT" S ZTSAVE(%)=""
  1.  D ^%ZTLOAD
  1.  G:'$D(ZTSK) DEV
  1.  K ZTSK
  1.  G K
  1.  ;
  1. START ;EP - TaskMan.
  1.  ;{ABK, 3/31/10}S ACHDISU=ACHDBDT-1,(ACHDTOT("$"),ACHDTOT)=0,ACHDT1=$$C^ACHS($S(ACHDBDT=1:"***   ALL DEFERRED SERVICES   ***",1:"For the period "_$$FMTE^XLFDT(ACHDBDT)_" through "_$$FMTE^XLFDT(ACHDEDT)),80)
  1.  S ACHDISU=ACHDBDT-1,(ACHDTOT("$"),ACHDTOT)=0,ACHDT1=$$C^ACHS($S(ACHDBDT=1:"***   ALL UNMET NEEDS   ***",1:"For the period "_$$FMTE^XLFDT(ACHDBDT)_" through "_$$FMTE^XLFDT(ACHDEDT)),80)
  1.  D BRPT^ACHS
  1.  D HDR
  1.  ;
  1. L1 ;
  1.  S ACHDISU=$O(^ACHSDEF(DUZ(2),"D","AISSUE",ACHDISU))
  1.  G END:+ACHDISU=0!(ACHDISU>ACHDEDT)
  1.  S ACHSA=0
  1. L2 ;
  1.  S ACHSA=$O(^ACHSDEF(DUZ(2),"D","AISSUE",ACHDISU,ACHSA))
  1.  G L1:+ACHSA=0
  1.  G L2:'$D(^ACHSDEF(DUZ(2),"D",ACHSA,0))
  1.  G L2:$E($G(^ACHSDEF(DUZ(2),"D","AISSUE",ACHDISU,ACHSA,0)))="#"  ;INCOMPLETE
  1.  ;{ABK, 3/31/10}G L2:$$DF^ACHS(0,14)="Y"  ;'DEFERRED SERVICE CANCELLED'
  1.  G L2:$$DF^ACHS(0,14)="Y"  ;'UNMET NEED CANCELLED'
  1.  ;
  1.  ;'IS PATIENT REGISTERED?'  NO GO GET NAME IF NOT THERE
  1.  I $$DF^ACHS(0,5)="N" G L2:'$L($$DF^ACHS(0,7)) S ACHDNAME=$$DF^ACHS(0,7) G L3
  1.  G L2:'$$DF^ACHS(0,6)            ;'REGISTERED PATIENT' PTR
  1.  G L2:'$D(^DPT($$DF^ACHS(0,6),0))
  1.  S ACHDNAME=$P($G(^DPT($$DF^ACHS(0,6),0)),U)   ;REG. PAT. NAME
  1. L3 ;
  1.  S ACHD("$")=""
  1.  W $$FMTE^XLFDT(ACHDISU)   ;'SERVICE DATE ISSUED'
  1.  W ?14,$$DF^ACHS(0,1)      ;'CHS DEFERRED SERVICE FACILITY'
  1.  W ?27,ACHDNAME,?65
  1.  S X=$$DF^ACHS(100,5),X2=2,X3=12
  1.  D FMT^ACHS
  1.  W !
  1.  I $Y>ACHSBM D RTRN^ACHS G K:$D(DUOUT)!$D(DTOUT)!($G(ACHSQUIT)) D HDR
  1.  S ACHDTOT=ACHDTOT+1
  1.  S ACHDTOT("$")=ACHDTOT("$")+$$DF^ACHS(100,5)    ;'ESTIMATED COST'
  1.  G L2
  1.  ;
  1. END ;
  1.  S X=ACHDTOT("$"),X2="2$",X3=16
  1.  D COMMA^%DTC
  1.  ;{ABK, 3/31/10}W !,$$REPEAT^XLFSTR("=",79),!,"TOTALS FOR THIS REPORT: ",ACHDTOT," DEFERRED SERVICE",$S(ACHDTOT=1:"",1:"S"),?61,X
  1.  W !,$$REPEAT^XLFSTR("=",79),!,"TOTALS FOR THIS REPORT: ",ACHDTOT," UNMET NEED",$S(ACHDTOT=1:"",1:"S"),?61,X
  1.  K ACHDHAT
  1.  D RTRN^ACHS
  1.  W @IOF
  1.  ;
  1. K ; --- Kill, End, Quit
  1.  K ACHD,ACHDISU,ACHDNAME,ACHDTOT,ACHSA
  1.  D ERPT^ACHS
  1.  Q
  1.  ;
  1. HDR ; --- Paginate, write headers
  1.  S ACHSPG=ACHSPG+1
  1.  ;{ABK, 3/31/10}W @IOF,!!,$$C^ACHS("***  CHS DENIAL/DEFERRED SERVICES  ***",80),!!,ACHSLOC,!?20,"DEFERRED SERVICES DOCUMENTS BY ISSUE DATE",?71,"Page",$J(ACHSPG,3)
  1.  W @IOF,!!,$$C^ACHS("***  CHS UNMET NEEDS  ***",80),!!,ACHSLOC,!?20,"UNMET NEEDS DOCUMENTS BY ISSUE DATE",?71,"Page",$J(ACHSPG,3)
  1.  W !,ACHSTIME,!!,ACHDT1,!!,"ISSUE DATE",?14,"DOCUMENT #",?27,"PATIENT",?69,"DOLLARS",!,$$REPEAT^XLFSTR("=",79),!
  1.  Q
  1.  ;