source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDCLAS1.m@ 623

SDCLAS1 ;ALB/TMP,MRY - Clinic Assignment Listing ; 12/23/02
 ;;5.3;Scheduling;**140,243**;Aug 13, 1993
 K Y,ONE,SDT,SDIFN,DIC,SDAPPT,SDCL,DFN,SDELIG,SDMT,SDMT1,SDLAST,SDNEXT,I,I1,SDTT
 S PG=0,PG1=1,SDCLIN=0
 F I=0:0 S SDCLIN=$N(^UTILITY($J,"S",SDCLIN)) Q:SDCLIN<0  D MTINIT F SDCL=0:0 S SDCL=$N(^UTILITY($J,"S",SDCLIN,SDCL)) D:SDCL'>0 TOT Q:SDCL'>0  S SDIFN=SDCL W @IOF D HDR S SDNAM=0 D PATIENT
 G END
MTINIT F I1="A","B","C","G","N","U","X","*" S I2="SDMT1(""""_I1_"""")",@I2=0
 Q
PATIENT F I1=0:0 S SDNAM=$N(^UTILITY($J,"S",SDCLIN,SDCL,SDNAM)) Q:SDNAM<0  F DFN=0:0 S DFN=$N(^UTILITY($J,"S",SDCLIN,SDCL,SDNAM,DFN)) Q:DFN'>0  D PRT
 Q
PRT I $Y>(IOSL-5) W @IOF D HDR
 S Y=^UTILITY($J,"S",SDCLIN,SDCL,SDNAM,DFN),Y1=^UTILITY($J,"PAT"," ",DFN)
 S SDACT=+$P(Y,"^",4),SDFLG=$S(SDACT&($P(Y,"^",5)):"*",SDACT&('$P(Y,"^",5)):"+",1:" ")
 W !,?0,SDFLG,SDNAM,?32,$P(Y1,"^") W ?45,$S($P(Y,"^",6)="O":"OPT",$P(Y,"^",6)="A":"AC",1:"")
 S SDEL=$S($D(^DIC(8,+$P(Y1,"^",2),0)):$P(^(0),"^"),1:"") W ?52,SDEL S SDEL1=$S(SDEL']"":"Unknown",1:+$P(Y1,"^",2)),SDELIG(SDEL1)=$S($D(SDELIG(SDEL1)):SDELIG(SDEL1)+1,1:1)
 S SDMT=$P(Y1,"^",5),SDMT1(SDMT)=SDMT1(SDMT)+1
 S X=+$P(Y,"^",3) I X D DAYS W ?87,X
 S SDY=Y,Y=$P(SDY,"^") D DTS^SDUTL W ?96,Y S Y=$P(SDY,"^",2) D DTS^SDUTL W ?110,Y S Y=SDY
 S X1=SDTS,X2=$P(Y1,"^",4) D AGE W ?124,SDAGE
 S SDCAT=$S(SDMT="U":"REQUIRED",SDMT="N":"NOT REQ",SDMT="*":"UNKNOWN",SDMT="U":"REQUIRED",SDMT="X":"NOT APPLICABLE",SDMT="A":"NSC MT COPAY EXEMPT",SDMT="C":"MT COPAY REQUIRED",SDMT="G":"GMT COPAY REQUIRED",1:"CATEGORY "_SDMT) W !?52,SDCAT
 Q
DAYS S X1=SDTS,X2=+X D ^%DTC Q
HDR S X1=$S($D(^SC(SDCL,0)):^(0),1:""),SDCLNAM=$P(X1,"^"),SDIV=$S($D(^DG(40.8,+$P(X1,"^",15),0)):$P(^(0),"^"),1:""),SDSTOP=$S($D(^DIC(40.7,+$P(X1,"^",7),0)):$P(^(0),"^",2),1:"")
HDR1 S PG=PG+1,PG1=0 W !,?2,"As of Date: " S Y=SDTS D DTS^SDUTL W Y,?53,"CLINIC  ASSIGNMENT  LISTING",?92,"Page ",PG,?106,"Stop Code ",SDSTOP,!,?2,"Print Date: " S Y=DT D DTS^SDUTL W Y
 S X=(132-$L(SDCLNAM)-4)\2+1 W ?X,"FOR ",SDCLNAM
 I SDIV]"" S X=(132-$L(SDIV))\2+1 W !,?X,SDIV
 W !! S SDL="",$P(SDL,"-",133)="" W SDL
 Q:$D(SDTT)  W !,?83,"Number of",?98,"Date of",?108,"Date of",!,?43,"Patient",?65,"Elig",?83,"Days",?98,"Last",?108,"Next",!,?12,"Name",?35,"SSN",?43,"Status",?65,"Code",?83,"Enrolled"
 W ?98,"Visit",?108,"Appointment",?124,"Age",!
 W !,?1,"* = Enrolled and active as of " S Y=SDTS D DTS^SDUTL W Y I 'SDFAST W !,?1,"+ = Enrolled as of ",Y," with no future appts."
 W !,SDL,! Q
TOT S SDTT="" Q:'$D(^SC(SDIFN))  I $Y>(IOSL-5) W @IOF D HDR1
 W !!,?3,"NUMBER OF ACTIVE PATIENTS   : ",$J(+$G(^UTILITY($J,"SDACT",SDIFN)),5) D CKHDR
 I 'SDFAST W !,?3,"NUMBER OF ENROLLED PATIENTS",!,?5,"(NO FUTURE APPOINTMENTS)  : ",$J(+$G(^UTILITY($J,"SDENR",SDIFN)),5) D CKHDR
 W !!,?3,"Eligibility Code Totals:     ",SDCLNAM,!! S X1=""
 F SDEL=0:0 S SDEL=$N(^DIC(8,SDEL)) S X1=$S(X1="":5,X1=93:5,1:X1+44) D:X1=5 CKHDR D PRT1 Q:SDEL'>0
 W !!,?3,"Means Test Category Totals:  ",SDCLNAM,!! S X1=""
 S SDMT="" F A=0:0 S SDMT=$O(SDMT1(SDMT)) Q:SDMT']""  S X1=$S(X1="":5,X1=49:5,1:49) D:X1=5 CKHDR D PRT2
 K SDELIG,SDMT1,SDTT Q
PRT1 W ?X1,$S(SDEL'>0:"Unknown",1:$P(^DIC(8,SDEL,0),"^",1)) S:SDEL'>0 SDEL="Unknown" W ?(X1+30),": ",$S($D(SDELIG(SDEL)):$J(SDELIG(SDEL),5),1:$J("0",5)) W:X1=93 !
 Q
PRT2 W ?X1,$S(SDMT["A":"NSC MT COPAY EXEMPT",SDMT["B":"CATEGORY B",SDMT["C":"MT COPAY REQUIRED",SDMT["G":"GMT COPAY REQUIRD",SDMT["N":"NON-VETERAN",SDMT["U":"REQUIRED (NOT DONE)",SDMT["X":"NOT APPLICABLE",1:"UNKNOWN")
 W ?(X1+19),": ",$S($D(SDMT1(SDMT)):$J(SDMT1(SDMT),5),1:$J("0",5)) W:X1=49 !
 Q
CKHDR I $Y>(IOSL-5) W @IOF D HDR1 W !
 Q
END W ! K %,%T,%Y,DGA1,DGX,A,A1,A2,A3,DG1,DGT,PGM,POP,VAL,VAR,X2,Y1,SDCL,SDTT,SDCLIN,SDNAM,PG,PG1,DFN,Y,I,I1,I2,I3,X,X1,SDEL,SDEL1,SDSTAT,SDCNTY,SDCLNAM,SDIV,SDSTOP,Z1,ZTSK,%IS,SD1,SDEN,ALL,DIV,SDI,SDAGE,SDIFN,SDSAV,SDSRT,SDY,SDZIP,SD,SDZ,SDHX
 K %ZIS,SD02,SDACT,SDENR,SDFAST,SDFLG,SDL,SDTS,SDMT,^UTILITY($J) D CLOSE^DGUTQ Q
AGE D ^%DTC S SDAGE=X\365 Q