source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCLAS1.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1SDCLAS1 ;ALB/TMP,MRY - Clinic Assignment Listing ; 12/23/02
2 ;;5.3;Scheduling;**140,243**;Aug 13, 1993
3 K Y,ONE,SDT,SDIFN,DIC,SDAPPT,SDCL,DFN,SDELIG,SDMT,SDMT1,SDLAST,SDNEXT,I,I1,SDTT
4 S PG=0,PG1=1,SDCLIN=0
5 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
6 G END
7MTINIT F I1="A","B","C","G","N","U","X","*" S I2="SDMT1(""""_I1_"""")",@I2=0
8 Q
9PATIENT 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
10 Q
11PRT I $Y>(IOSL-5) W @IOF D HDR
12 S Y=^UTILITY($J,"S",SDCLIN,SDCL,SDNAM,DFN),Y1=^UTILITY($J,"PAT"," ",DFN)
13 S SDACT=+$P(Y,"^",4),SDFLG=$S(SDACT&($P(Y,"^",5)):"*",SDACT&('$P(Y,"^",5)):"+",1:" ")
14 W !,?0,SDFLG,SDNAM,?32,$P(Y1,"^") W ?45,$S($P(Y,"^",6)="O":"OPT",$P(Y,"^",6)="A":"AC",1:"")
15 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)
16 S SDMT=$P(Y1,"^",5),SDMT1(SDMT)=SDMT1(SDMT)+1
17 S X=+$P(Y,"^",3) I X D DAYS W ?87,X
18 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
19 S X1=SDTS,X2=$P(Y1,"^",4) D AGE W ?124,SDAGE
20 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
21 Q
22DAYS S X1=SDTS,X2=+X D ^%DTC Q
23HDR 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:"")
24HDR1 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
25 S X=(132-$L(SDCLNAM)-4)\2+1 W ?X,"FOR ",SDCLNAM
26 I SDIV]"" S X=(132-$L(SDIV))\2+1 W !,?X,SDIV
27 W !! S SDL="",$P(SDL,"-",133)="" W SDL
28 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"
29 W ?98,"Visit",?108,"Appointment",?124,"Age",!
30 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."
31 W !,SDL,! Q
32TOT S SDTT="" Q:'$D(^SC(SDIFN)) I $Y>(IOSL-5) W @IOF D HDR1
33 W !!,?3,"NUMBER OF ACTIVE PATIENTS : ",$J(+$G(^UTILITY($J,"SDACT",SDIFN)),5) D CKHDR
34 I 'SDFAST W !,?3,"NUMBER OF ENROLLED PATIENTS",!,?5,"(NO FUTURE APPOINTMENTS) : ",$J(+$G(^UTILITY($J,"SDENR",SDIFN)),5) D CKHDR
35 W !!,?3,"Eligibility Code Totals: ",SDCLNAM,!! S X1=""
36 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
37 W !!,?3,"Means Test Category Totals: ",SDCLNAM,!! S X1=""
38 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
39 K SDELIG,SDMT1,SDTT Q
40PRT1 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 !
41 Q
42PRT2 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")
43 W ?(X1+19),": ",$S($D(SDMT1(SDMT)):$J(SDMT1(SDMT),5),1:$J("0",5)) W:X1=49 !
44 Q
45CKHDR I $Y>(IOSL-5) W @IOF D HDR1 W !
46 Q
47END 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
48 K %ZIS,SD02,SDACT,SDENR,SDFAST,SDFLG,SDL,SDTS,SDMT,^UTILITY($J) D CLOSE^DGUTQ Q
49AGE D ^%DTC S SDAGE=X\365 Q
Note: See TracBrowser for help on using the repository browser.