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