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

SDCLAS1.m

Go to the documentation of this file.
  1. SDCLAS1 ;ALB/TMP,MRY - Clinic Assignment Listing ; 12/23/02
  1. ;;5.3;Scheduling;**140,243**;Aug 13, 1993
  1. K Y,ONE,SDT,SDIFN,DIC,SDAPPT,SDCL,DFN,SDELIG,SDMT,SDMT1,SDLAST,SDNEXT,I,I1,SDTT
  1. S PG=0,PG1=1,SDCLIN=0
  1. 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
  1. G END
  1. MTINIT F I1="A","B","C","G","N","U","X","*" S I2="SDMT1(""""_I1_"""")",@I2=0
  1. Q
  1. 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
  1. Q
  1. PRT I $Y>(IOSL-5) W @IOF D HDR
  1. S Y=^UTILITY($J,"S",SDCLIN,SDCL,SDNAM,DFN),Y1=^UTILITY($J,"PAT"," ",DFN)
  1. S SDACT=+$P(Y,"^",4),SDFLG=$S(SDACT&($P(Y,"^",5)):"*",SDACT&('$P(Y,"^",5)):"+",1:" ")
  1. W !,?0,SDFLG,SDNAM,?32,$P(Y1,"^") W ?45,$S($P(Y,"^",6)="O":"OPT",$P(Y,"^",6)="A":"AC",1:"")
  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)
  1. S SDMT=$P(Y1,"^",5),SDMT1(SDMT)=SDMT1(SDMT)+1
  1. S X=+$P(Y,"^",3) I X D DAYS W ?87,X
  1. 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
  1. S X1=SDTS,X2=$P(Y1,"^",4) D AGE W ?124,SDAGE
  1. 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
  1. Q
  1. DAYS S X1=SDTS,X2=+X D ^%DTC Q
  1. 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:"")
  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
  1. S X=(132-$L(SDCLNAM)-4)\2+1 W ?X,"FOR ",SDCLNAM
  1. I SDIV]"" S X=(132-$L(SDIV))\2+1 W !,?X,SDIV
  1. W !! S SDL="",$P(SDL,"-",133)="" W SDL
  1. 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"
  1. W ?98,"Visit",?108,"Appointment",?124,"Age",!
  1. 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."
  1. W !,SDL,! Q
  1. TOT S SDTT="" Q:'$D(^SC(SDIFN)) I $Y>(IOSL-5) W @IOF D HDR1
  1. W !!,?3,"NUMBER OF ACTIVE PATIENTS : ",$J(+$G(^UTILITY($J,"SDACT",SDIFN)),5) D CKHDR
  1. I 'SDFAST W !,?3,"NUMBER OF ENROLLED PATIENTS",!,?5,"(NO FUTURE APPOINTMENTS) : ",$J(+$G(^UTILITY($J,"SDENR",SDIFN)),5) D CKHDR
  1. W !!,?3,"Eligibility Code Totals: ",SDCLNAM,!! S X1=""
  1. 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
  1. W !!,?3,"Means Test Category Totals: ",SDCLNAM,!! S X1=""
  1. 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
  1. K SDELIG,SDMT1,SDTT Q
  1. 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 !
  1. Q
  1. 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")
  1. W ?(X1+19),": ",$S($D(SDMT1(SDMT)):$J(SDMT1(SDMT),5),1:$J("0",5)) W:X1=49 !
  1. Q
  1. CKHDR I $Y>(IOSL-5) W @IOF D HDR1 W !
  1. Q
  1. 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
  1. K %ZIS,SD02,SDACT,SDENR,SDFAST,SDFLG,SDL,SDTS,SDMT,^UTILITY($J) D CLOSE^DGUTQ Q
  1. AGE D ^%DTC S SDAGE=X\365 Q