source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSWX.m@ 699

Last change on this file since 699 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1YSWX ;ALB/ASF-WAIT LISTS ;4/4/90 12:48 ;
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
41 ; Called by routine YSWZ
5 S DIC="^YSG(""WAIT"",",DIC(0)="AEQ" S:$D(N2) DIC("B")=N2 D ^DIC I Y<1 K N2,N,DIC("B") Q
6 S N=+Y,N2=$P(Y,U,2) K DIC("B") Q
72 ; Called by routine YSWZ
8 S DIC="^YSG(""WAIT"","_N_",1,",DA(1)=N D ^DIC Q:Y<1 S N1=+Y,DA=+Y Q:'$D(YSM) I +$P(^YSG("WAIT",N,1,N1,0),U,2) W !,"PATIENT PRESENTLY ON ",N2," LIST." Q
9 S DIE=DIC,DR="1///NOW;2///^S X=""`""_DUZ;7///"_(+$H_"."_$P($H,",",2))_";3:6;8" L +^YSG("WAIT",N) D ^DIE L -^YSG("WAIT",N) S YSTOUT=$D(DUOUT),YSUOUT=$O(Y(""))]""
10 I YSTOUT!YSUOUT D ZAP K Y Q
11 K YSM Q
12ZAP ;
13 S DIK="^YSG(""WAIT"","_N_",1,",DA=N1,V=$P(^YSG("WAIT",N,1,N1,0),U) D ^DIK S V1=^DPT(V,0),V2=$P(V1,U) W !,"< ",V2," DELETED! >" Q
14 Q
153 ; Called by routine YSWZ
16 S DIE="^YSG(""WAIT"","_N_",1,",DA=N1,DR="2///^S X=""`""_DUZ;3:6;8" L +^YSG("WAIT",N) D ^DIE L -^YSG("WAIT",N) S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]""
17 Q
184 ; Called by routine YSWZ
19 D SHUF^YSWX1 Q:H1'?3N.NP S DIE="^YSG(""WAIT"","_N_",1,",DA=N1,DR="2///^S X=""`""_DUZ;7///"_H1_";8" L +^YSG("WAIT",N) D ^DIE L -^YSG("WAIT",N) K ^UTILITY($J) S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]""
20 Q
215 ; Called by routine YSWZ
22 S DIE="^YSG(""WAIT"","_N_",1,",DA(1)=N,DA=N1,DR=".01////@" L +^YSG("WAIT",N) D ^DIE L -^YSG("WAIT",N) S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]""
23 Q
24LP ; Called by routine YSWZ
25 S YSELIG=$P(^YSG("WAIT",N,0),U,3)
26 K ^UTILITY($J) S N3=0 F S N3=$O(^YSG("WAIT",N,1,N3)) Q:'N3 S E1=^(N3,0),S1=$P(E1,U,7),S2=$P(E1,U,8) S:YSELIG="N" S1=0 S ^UTILITY($J,S1,S2)=E1
27 Q
28DSP ; Called by routine YSWZ
29 U IO S YSLFT=0 W @IOF F X9=0,1,2,3 I $D(^UTILITY($J,X9)) D HDR,DSP1 Q:YSLFT
30 I $P(^YSG("WAIT",N,1,0),U,4)<1 W !!,"NO PATIENTS LISTED" I $D(N2) W " ON ",N2,!
31 I IOST?1"C-".E D:'YSLFT WAIT^YSUTL
32 Q
33DSP1 ;
34 S X3=0 F W1=1:1 S X3=$O(^UTILITY($J,X9,X3)) Q:'X3 S (YSCOMM,YSOND,YSBY,YSPROM,YSCONT,YSCAT)="",E1=^(X3),YSDFN=+E1,YSOND=$P(E1,U,2),YSBY=$P(E1,U,3),YSPROM=$P(E1,U,4),YSCONT=$P(E1,U,5),YSCAT=$P(E1,U,6),YSCOMM=$P(E1,U,9) D DSP2 Q:YSLFT
35 Q
36DSP2 ;
37 D PT W !,W1,?3,$P(YSNM,","),",",$E($P(YSNM,",",2)),?25,$P(YSSSN,"-",3),?31,$$FMTE^XLFDT(YSOND,"5ZD"),?42,$P(^VA(200,YSBY,0),U,2)
38 S X1=DT,X2=YSOND D ^%DTC W ?46,$J(X,3),?51,$$FMTE^XLFDT(YSPROM,"5ZD"),?62,$$FMTE^XLFDT(YSCONT,"5ZD"),?74,YSCAT,!?7,"COMMENT: ",YSCOMM
39 I $Y>(IOSL-5) D:IOST?1"C-".E WAIT^YSUTL Q:YSLFT W @IOF,! D HDR
40 Q
41PT ;
42 S X=^DPT(YSDFN,0),DFN=YSDFN D DEM^VADPT,PID^VADPT
43 S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID") K X,VA,VADM,DFN Q
44HDR ;
45 W !!?5,$P(^YSG("WAIT",N,0),U)," WAIT LIST ",$$FMTE^XLFDT(DT,"5ZD"),?$X+3,$S(X9=1:"SERVICE CONNECTED",X9=2:"CONTRACT/OTHERS",X9=3:"NON-SERVICE CONNECTED",1:"")
46HDR1 ;
47 W !?5,"NAME",?25,"SSN",?31,"LISTED",?42,"BY",?46,"DAYS",?51,"PROMISED",?62,"CONTACT",?74,"CAT",! Q
Note: See TracBrowser for help on using the repository browser.