source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPPJ.m@ 1489

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1YSPPJ ;ALB/ASF-JUMP BETWEEN INQUIRY SCREENS ;4/14/93 17:31 ;07/07/93 14:10
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4FIND ; Called from MENU option YSPATPROF
5 F D ONE Q:YSDFN<1
6 K YSDFN D QUIT
7 Q
8 ;
9ONE ;
10 W @IOF D ^YSLRP Q:YSDFN<1 S (DA,DFN)=YSDFN D DEM^VADPT,PID^VADPT,HOME^%ZIS
11 D:$D(XRTL) T0^%ZOSV ; START Response check measure
12 S X="IORVON;IORVOFF" D ENDR^%ZISS
13 F I=0,.11,.111,.13,.21,.211,.24,.15,.3,.311,.31,.321,.32,.33,.331,.34,.362,.36,.52,1010.15 S A(I)="" S:$D(^DPT(DA,I))#10 A(I)=^(I)
14MENU ;
15 W @IOF,"NAME: ",VADM(1),?40,"SSN: ",YSSSN,?60,"DOB: ",$P(VADM(3),U,2) S PROFILE=1,HOLDA=A(0)
16 W !!?5 W IORVON," P A T I E N T P R O F I L E ",IORVOFF W !
17 F YSI=1:1 S G=$T(PROG+YSI) Q:G="" S G3=$P(G,";",4),G4=$P(G,";",5),G5=$P(G,";",6) W !,$J(YSI,2),".",?5,G3 I G4]"" X G4 I '$T W ?45,IORVON," no ",G5,?78,IORVOFF
18 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; STOP Response check measure
19M ;
20 K DIR
21 S A8=0 W !!
22 S DIR(0)="FO^1:24",DIR("A")="Enter section number(s) or 'P' to print or 'Q' for quick look ",DIR("?")="Enter a numeric string ex. 2,4,7-9"
23 S DIR("?",1)="'P' or 'p' for print 'Q' or 'q' for quick look" D ^DIR K DIR S A1=Y
24 I $D(DIRUT) D QUIT S YSDFN=-1 Q
25 I $E(A1,1)="-" W:A1'["?" " ?",$C(7) D MSG1^YSEMSG G MENU
26 I A1["-"!(A1[11) D LIST S A1=YSEXT
27 S A1=$TR(A1,"pq","PQ")
28 G MENU2:A1,MENU1:"P"[A1 I "Q"'[A1 W:A1'["?" " ?",$C(7) D MSG1^YSEMSG G MENU
29 D EN^YSDGDEM Q
30LIST ;
31 K YSRY S CT=0,ANS=A1
32 ;
33 ; Did user enter a range, or selection including 11 + more'n 11?
34 I $G(ANS)[11&(+ANS'=11) D
35 . S ANS="1-10"
36 . W !!,"Including all sections...",!!
37 ;
38 F YSI=1:1:$L(ANS,",") S X=$P(ANS,",",YSI) I +X>0 S CT=CT+1,YSRY(CT)=$P(ANS,",",YSI)
39 ;
40 S YSEXT="",OK=1
41 S YSLN=0 F S YSLN=$O(YSRY(YSLN)) QUIT:YSLN'>0 D QUIT:OK=0
42 . S SUB=$G(YSRY(YSLN)) QUIT:SUB']"" ;->
43 . I +SUB=SUB S YSEXT=YSEXT_+SUB_"," QUIT
44 . I SUB?1.2N1"-"1.2N D S YSRY(YSLN)=YSEXT
45 . . S X=+SUB,Y=+$P(SUB,"-",2)
46 . . I X>Y!(Y>10) S OK=0 QUIT
47 . . F YSAI=X:1:Y S YSEXT=YSEXT_YSAI_","
48 I OK=0 W:A1'["?" " ?",$C(7) D MSG1^YSEMSG G MENU
49 I $E(YSEXT,$L(YSEXT))="," S YSEXT=$E(YSEXT,1,$L(YSEXT)-1)
50 Q
51 ;
52MENU1 ;
53 S DIR(0)="LO^1:11" D ^DIR K DIR I $D(DIRUT)!('Y) Q
54 S A8=Y
55 I A8[11 S A8="1,2,3,4,5,6,7,8,9,10" W !!,"Including all sections...",!!
56MENU2 ;
57 I 'A8 S A8=$S(A1=11:"1,2,3,4,5,6,7,8,9,10",A1?1N.1",".E:A1,1:"") I 'A8 D QUIT Q
58 I A8<1!(A8>10) W:A1'["?" " ?",$C(7) D MSG1^YSEMSG G MENU
59AD ;
60 I IOST?1"C-".E,A8?1N.N I $L(A1)>1!(A1=10) F I=A8+1:1:10 S A8=A8_","_I
61 S YSA8=A8 K IOP S %ZIS="Q" D ^%ZIS I POP D QUIT S YSDFN=-1 Q
62 I $D(IO("Q")),IOST?1"C-".E W " - You can't queue to a CRT!",$C(7) K IO("Q") G AD
63 I $D(IO("Q")) S ZTRTN="ENP^YSPPJ",(ZTSAVE("YS*"),ZTSAVE("DFN"),ZTSAVE("A("),ZTSAVE("DA"))="",ZTSAVE("PROFILE")="",ZTSAVE("HOLDA")="",ZTDESC="YS PROFILE PRT" D ^%ZTLOAD,HOME^%ZIS,QUIT Q
64 ;
65ENP ; Called by routine YSCEN39
66 S YST=$S(IOST?1"C-".E:0,1:1),YSLFT=0 U IO
67 F YSI=1:1 S A1=$P(YSA8,",",YSI) Q:A1=""!(YSLFT) I A1>0,A1<11 S A2=$P($T(PROG+A1),";",3) D @A2
68 G:$D(YSCENN) QUIT
69 ;K YSA8 I YSLFT,A1 K A1,A8 D MENU ;Commented 7/7/93 LJA
70FIN ;
71 D ^%ZISC,HOME^%ZIS S A(0)=HOLDA I $G(ZTSK) S ZTREQ="@"
72QUIT ;
73 K %,%ZIS,A,ANS,A1,A2,A6,A7,A8,C,CT,D,DA,DIC,YSDT(0),YSDT(1),G,G3,G4,G5,I0,IO("Q"),I1,I2,I3,L,L1,L2,L3,L4,N3,R1,R2,S,SUB,S2,S5,X,X1,X2
74 K Y,YSA8,YSADMDT,YSAGE,YSAI,YSCON,YSCOV,YSDISP,YSDOB,YSEXT,YSFA,YSFTR,YSFHDR,YSI,YSIA,YSLFT,YSLN,YSNM,YSPNH,YSRY,YSSEX,YSSKIP,YSSSN,YST,YSTB,YSTRNDT,ZTSK
75 D KILL^%ZISS,KVAR^VADPT
76 K AI,DX1,DX2,DX3,G11,J,K,L10,L11,L5,L6,L8,L9,N1,RDT,ST,ST1,STDT,YSDXNN,YSCLI,YSOC,PROFILE,HOLDA Q:$D(YSCENN)
77 Q
78PROG ;
791 ;;^YSPP;Identifying data
802 ;;^YSPP1;Next of kin, employment, claim number
813 ;;^YSPP1A;Disability, financial
824 ;;^YSPP2;Military
835 ;;^YSPP4;Inpatient data/Application for care;I $D(^DGPM("ATID1",YSDFN));inpatient admissions
846 ;;^YSPP5;Outpatient data;I $D(^DPT(YSDFN,"DE"))>0!($D(^DPT(YSDFN,"S"))>0);appointment data
857 ;;^YSPP6;DSM/ICD9 Diagnosis list;I $D(^YSD(627.8,"AF",YSDFN))>0;diagnosis
868 ;;^YSPP7;Last physical exam;IF $D(^MR(YSDFN,"PE"))>0;physical
879 ;;^YSPP8;Problem list, MH tests & interviews;I $D(^YTD(601.2,"B",YSDFN))>0;tests/interviews
8810 ;;^YSPP9;Short problem list;IF $D(^YS(615,YSDFN,"PL"))>0;problem list
8911 ;;;All Sections;;
Note: See TracBrowser for help on using the repository browser.