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

AGELUPR.m

Go to the documentation of this file. 
  1. AGELUPR ;IHS/ASDS/EFG - PRINT CMS FILE PROCESS LOG ;  
  1.  ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
  1.  ;
  1. START ;start
  1.  NEW AGDA,DIC
  1.  S DIC="^AGELUPLG(",DIC(0)="AEMQ"
  1.  D ^DIC
  1.  Q:+Y<0
  1.  S AGDA=+Y
  1.  D ^%ZIS
  1.  Q:POP
  1.  I IO'=IO(0) D QUE,HOME^%ZIS Q
  1.  D PRINT,^%ZISC
  1.  Q
  1. QUE ;que to taskman
  1.  S ZTRTN="PRINT^AGELUPR",ZTSAVE("AGDA")="",ZTDESC="Eligibility Upload Log"
  1.  D ^%ZTLOAD
  1.  I $G(ZTSK) W !,"Task # ",ZTSK," queued."
  1.  Q
  1. PRINT ;EP - From Taskman.  Print the report.
  1.  NEW AGCAT,AGCNT,AGMVDF,AGPG,AGQUIT,AGRDT,DFN
  1.  S (AGPG,AGQUIT)=0,AGCAT="ADDED",AGRDT=$P(^AGELUPLG(AGDA,0),U,1)
  1.  D HDR
  1.  S (AGCNT,DFN)=0
  1.  F  S DFN=$O(^AGELUPLG(AGDA,1,DFN)) Q:'DFN  D ONE Q:AGQUIT
  1.  Q:AGQUIT
  1.  D END
  1.  Q:AGQUIT
  1.  S AGCAT="EDITED"
  1.  D HDR
  1.  S (AGCNT,DFN)=0
  1.  F  S DFN=$O(^AGELUPLG(AGDA,2,DFN)) Q:'DFN  D ONE Q:AGQUIT
  1.  Q:AGQUIT
  1.  D END
  1.  Q:AGQUIT
  1.  W @IOF
  1.  Q
  1. ONE ;print one patient
  1.  W !,$P(^DPT(DFN,0),U,1),?40 S Y=$P(^(0),U,9) X ^DD(2,.09,2) W Y
  1.  S AGCNT=AGCNT+1
  1.  I $Y+3>IOSL D
  1.  . I $E(IOST)="C" S AGQUIT='$$DIR^XBDIR("E")
  1.  . Q:AGQUIT
  1.  . D HDR
  1.  .Q
  1.  Q
  1. HDR ;EP - page header
  1.  S AGPG=AGPG+1
  1.  W @IOF,!,$$CJ^XLFSTR("ELIGIBILITY UPLOAD LOG",IOM),!,"Upload Run Date: ",$$FMTE^XLFDT(AGRDT,1),?70,"Page ",AGPG
  1.  W !?11,"File: ",$$GET1^DIQ(9009062.02,AGDA,.03),"    #Records: ",$FN($$GET1^DIQ(9009062.02,AGDA,.04),","),!?7,"Template: ",$$GET1^DIQ(9009062.02,AGDA,.02),!,$$REPEAT^XLFSTR("=",80),!,"Patients ",AGCAT
  1.  I AGPG=1 D:AGCAT="ADDED" HDR1
  1.  W !,"Patient",?40,"Social Security Number",!,$$REPEAT^XLFSTR("-",30),?40,$$REPEAT^XLFSTR("-",22)
  1.  Q
  1. HDR1 ;
  1.  W ?26,"Before",?45,"After",?63,"Added"
  1.  W !,"MEDICARE ELIGIBLE file: ",$J($FN($$GET1^DIQ(9009062.02,AGDA,.06),","),8),"   ",$J($FN($$GET1^DIQ(9009062.02,AGDA,.07),","),8),"        = "
  1.  W $J($FN($$GET1^DIQ(9009062.02,AGDA,.07)-$$GET1^DIQ(9009062.02,AGDA,.06),","),8)
  1.  W !,"RAILROAD ELIGIBLE file: ",$J($FN($$GET1^DIQ(9009062.02,AGDA,.08),","),8),"   ",$J($FN($$GET1^DIQ(9009062.02,AGDA,.09),","),8),"        = "
  1.  W $J($FN($$GET1^DIQ(9009062.02,AGDA,.09)-$$GET1^DIQ(9009062.02,AGDA,.08),","),8)
  1.  W !,"MEDICAID ELIGIBLE file: ",$J($FN($$GET1^DIQ(9009062.02,AGDA,.11),","),8),"   ",$J($FN($$GET1^DIQ(9009062.02,AGDA,.12),","),8),"        = "
  1.  W $J($FN($$GET1^DIQ(9009062.02,AGDA,.12)-$$GET1^DIQ(9009062.02,AGDA,.11),","),8)
  1.  Q
  1. END ;end of patients
  1.  W !!,"TOTAL PATIENTS ",AGCAT,"  ",AGCNT
  1.  I $E(IOST)="C" S AGQUIT='$$DIR^XBDIR("E")
  1.  Q
  1. TMPLT ;AG(V,N,S,P) = AG(value,name,subscript,piece)
  1.  W !,"*** Print a template format ***",!
  1.  NEW AG,DIC,Y
  1.  S DIC="^AGELUP(",DIC(0)="AEMQ"
  1.  D ^DIC
  1.  Q:+Y<0
  1.  S AG=+Y
  1.  NEW DA,V,N,S,P
  1.  S DA=0
  1.  F  S DA=$O(^DD(9009062.01,DA)) Q:'DA  S S=$P(^(DA,0),U,4),P=$P(S,";",2),S=$P(S,";",1),V=$P($G(^AGELUP(AG,S)),U,P) I $L(V) S N=$P(^DD(9009062.01,DA,0),U,1),AG(V,N,S,P)=""
  1.  S V=999
  1.  F  S V=$O(AG(V)) Q:'$L(V)  S N=$O(AG(V,"")) W !,$J(N,20),":  ",V
  1.  S V=0
  1.  F  S V=$O(AG(V)) Q:'V  S N=$O(AG(V,"")) W !,$J(V,8),"  ",N
  1.  Q