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

ACHSODP.m

Go to the documentation of this file. 
  1. ACHSODP ; IHS/ITSC/PMF - PRINT DCR REPORT (1/3) ;   [ 10/16/2001   8:16 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1. A0 ;
  1.  G END:'$D(^TMP("ACHSOD",$J,DUZ(2),0))
  1.  S ACHSZYR=$O(^TMP("ACHSOD",$J,DUZ(2),"DCR",0))
  1.  G END:+ACHSZYR<1980
  1.  S X=$G(^TMP("ACHSOD",$J,DUZ(2),"DCR",ACHSZYR,0)),ACHSBDT=$P(X,U,3),ACHSEDT=$P(X,U,4),(ACHSFYY,ACHSPG)=0,ACHSLOC=""
  1.  S ACHST1=$$C^XBFUNC($$FMTE^XLFDT(ACHSBDT)_" Thru "_$$FMTE^XLFDT(ACHSEDT),80),ACHSLOC=$$LOC^ACHS,ACHSCHSS=""
  1.  D FC^ACHSUF
  1.  I $D(ACHSERR),ACHSERR=1 G END
  1.  D NOW^ACHS
  1. A1 ;
  1.  S ACHSFYY=$O(^TMP("ACHSOD",$J,DUZ(2),ACHSFYY)) G B9:ACHSFYY<1,A1:'$D(^("DCR",ACHSFYY,0)) S X=$P(^(0),U,6),ACHSRGNM=$E(ACHSFYY,4)_"-"_$E(1000+X,2,4),ACHSREG=X
  1.  K ACHSSUM
  1.  F ACHS=1:1:7 S ACHSSUM(ACHS)=""
  1.  D HDR,HDR1
  1.  S ACHSACD="",ACHSDIEN=0,ACHSDPFX=$E(ACHSFYY,4)_"-"_ACHSFC_"-"
  1. A2 ;
  1.  S ACHSACD=$O(^TMP("ACHSOD",$J,DUZ(2),ACHSFYY,ACHSACD))
  1.  G B1:ACHSACD<1
  1.  S ACHSDIEN=0
  1. A3 ;
  1.  S ACHSDIEN=$O(^TMP("ACHSOD",$J,DUZ(2),ACHSFYY,ACHSACD,ACHSDIEN))
  1.  G A2:ACHSDIEN<1
  1.  S ACHSTN=0
  1. A4 ;
  1.  S ACHSTN=$O(^TMP("ACHSOD",$J,DUZ(2),ACHSFYY,ACHSACD,ACHSDIEN,ACHSTN)) G A3:ACHSTN<1 S ACHSACS=$G(^TMP("ACHSOD",$J,DUZ(2),ACHSFYY,ACHSACD,ACHSDIEN,ACHSTN))
  1.  I $Y>(IOSL-6) D RTRN^ACHS,HDR,HDR1
  1.  D ^ACHSODP1
  1.  G A4
  1.  ;
  1. B1 ;
  1.  D RTRN^ACHS,HDR
  1.  D SUMMARY:$D(^TMP("ACHSOD",$J,DUZ(2),"TRAN",ACHSFYY))
  1.  D RTRN^ACHS,HDR,^ACHSODP2
  1.  G A1
  1.  ;
  1. B9 ;
  1.  W @IOF
  1.  K A,ACHSRGNM,ACHSSET,ACHSSUM,ACHSTS,ACHSBDT,ACHSDIEN,ACHSDIEN,ACHSDPFX,ACHSEBAL,ACHSEDT,ACHSFYY,ACHSREG,ACHSACS,ACHSTN,DFN,ACHSTY,X2,X3,ACHSZYR
  1. END ;
  1.  S ACHSNUM=ACHSNUM-1
  1.  I ACHSNUM>0 G A0
  1.  I $D(ACHS("DCR")) K ACHS("DCR") G AUTO1^ACHSNEW
  1.  D ERPT^ACHS
  1.  Q
  1.  ;
  1. HDR ;
  1.  U ACHSIO
  1.  S ACHSPG=ACHSPG+1
  1.  W @IOF,?80-$L(ACHSLOC)/2,ACHSLOC,!,ACHSTIME,?25,"CHS DOCUMENT CONTROL REGISTER",?72,"Page ",ACHSPG,!?80-$L(ACHSRGNM)/2,ACHSRGNM,!,ACHST1,!
  1.  Q
  1.  ;
  1. HDR1 ;EP.
  1.  W !,"Patient",?22,"Provider of Service",?49,"Issue /DOS",?62,"Type",!,"Document",?22,"Ein #",?49,"Serv",?62,"Dest",?74,"Amount",!,"-----------------",?22,"-------------------------",?49,"-----------",?62,"-------",?72,"--------"
  1.  Q
  1.  ;
  1. HDR2 ;EP.
  1.  W !!!?7,"Type Document",?40,"No. Documents",?61,"Obligations",!?5,"----------------",?40,"--------------",?60,"--------------"
  1.  Q
  1.  ;
  1. SUMMARY ;
  1.  D HDR2
  1.  S ACHSCT=0
  1.  W !!
  1.  F ACHSTYPE="INITIAL","SUPPLEMENTS","CANCEL","PAYMENTS","ADJUSTMENT","INTERIM PAYMENTS" D
  1.  . I $D(^TMP("ACHSOD",$J,DUZ(2),ACHSTYPE,ACHSFYY)) S ACHS=$P(^(ACHSFYY),U),X=$P(^(ACHSFYY),U,2),ACHSCT=ACHSCT+X D COMMA^%DTC D
  1.  .. W !?5,ACHSTYPE," DOCUMENTS",?46,$J(ACHS,3),?63,X
  1.  .. I ACHSTYPE="INTERIM PAYMENTS" W " ***" S ACHSIP=1
  1.  ..Q
  1.  .Q
  1.  W !?46,"-----",?60,"---------------"
  1.  S X=ACHSCT
  1.  D COMMA^%DTC
  1.  S ACHSCT=X
  1.  W !!?5,"TOTALS",?46,$J(^TMP("ACHSOD",$J,DUZ(2),"TRAN",ACHSFYY),3),?63,$J(ACHSCT,9)
  1.  W:$D(ACHSIP) !!?5,"*** Interim Payments Not Reflected In Totals"
  1.  K ACHSIP
  1.  W !!!?5,"FISCAL AGENT DOCUMENTS: "
  1.  W:$D(^TMP("ACHSOD",$J,DUZ(2),"FISCAL AGENT",ACHSFYY)) $J(^(ACHSFYY),4)
  1.  W !?14,"IHS DOCUMENTS: "
  1.  W:$D(^TMP("ACHSOD",$J,DUZ(2),"IHS",ACHSFYY)) ?24,$J(^(ACHSFYY),4)
  1.  W !!?8,"OBLIG DHR DOCUMENTS: "
  1.  W:$D(^TMP("ACHSOD",$J,DUZ(2),"DHR",ACHSFYY)) ?24,$J(^(ACHSFYY),4)
  1.  Q
  1.  ;