| 1 | YSHX1 ;SLC/DKG-HISTORY OF PRESENT ILLNESS ;4/20/92 09:25 ;08/12/93 17:41
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**9**;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ; Called from the top by MENU option YSHX1
|
|---|
| 5 | ;
|
|---|
| 6 | S YSHX="HX",P=","
|
|---|
| 7 | 1 ;
|
|---|
| 8 | W ! D ^YSLRP G:YSDFN<1 END S YSDT=DT W @IOF,!!?3,"HISTORY PART ONE FOR ",YSNM," ",YSSEX," AGE ",YSAGE,!!
|
|---|
| 9 | FN ;
|
|---|
| 10 | D DTS G END:YSTOUT!YSUOUT K ^UTILITY($J,"W")
|
|---|
| 11 | EL ;
|
|---|
| 12 | W !!?3,"(E)nter" W:'YSNH "/Edit, (P)rint" R " OR (Q)uit: E// ",A1:DTIME S YSTOUT='$T,YSUOUT=A1["^" S:A1="" A1="E" S A1=$TR($E(A1),"epq","EPQ")
|
|---|
| 13 | G END:YSTOUT!YSUOUT,ENT:A1="E",^YSHX1R:A1="P"&'YSNH,1:A1="Q",ELQ
|
|---|
| 14 | ENT ;
|
|---|
| 15 | S YSIDT=9999999-YSDT,YSCD=1,^PTX(YSDFN,YSHX,YSIDT,1,DUZ,1,YSCD,1,0)="",DIC="^PTX(YSDFN,YSHX,YSIDT,1,DUZ,1,YSCD,1,"
|
|---|
| 16 | N DIWESUB S DIWESUB="Chief Complaint",DIWEPSE=1
|
|---|
| 17 | W !!,"CHIEF COMPLAINT: "
|
|---|
| 18 | D ENDTM^YSUTL S DWPK=1 D EN^DIWE
|
|---|
| 19 | I '($D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,1,YSCD,1,1,0))#2) K ^PTX(YSDFN,YSHX,YSIDT,1,DUZ,1,YSCD,1,0) G HS
|
|---|
| 20 | L +^PTX(YSDFN) S ^PTX(YSDFN,YSHX,YSIDT,1,DUZ,0)=DUZ,^(1,0)="^99.07D^1^1" S:'$D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,1,YSCD,0)) ^(0)=YSDTM L -^PTX(YSDFN)
|
|---|
| 21 | HS ;
|
|---|
| 22 | S ^PTX(YSDFN,YSHX,YSIDT,1,DUZ,2,YSCD,1,0)="",DIC="^PTX(YSDFN,YSHX,YSIDT,1,DUZ,2,YSCD,1,"
|
|---|
| 23 | S DIWESUB="Hx of Present Illness",DIWEPSE=1
|
|---|
| 24 | W !!,"HISTORY OF PRESENT ILLNESS: "
|
|---|
| 25 | D ENDTM^YSUTL S DWPK=1 D EN^DIWE
|
|---|
| 26 | I '($D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,2,YSCD,1,1,0))#2) K ^PTX(YSDFN,YSHX,YSIDT,1,DUZ,2,YSCD,1,0) G MD
|
|---|
| 27 | L +^PTX(YSDFN) S:'$D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,0)) ^(0)=DUZ S ^(2,0)="^99.09D^1^1" S:'$D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,2,YSCD,0)) ^(0)=YSDTM L -^PTX(YSDFN)
|
|---|
| 28 | MD ;
|
|---|
| 29 | S ^PTX(YSDFN,YSHX,YSIDT,1,DUZ,3,YSCD,1,0)="",DIC="^PTX(YSDFN,YSHX,YSIDT,1,DUZ,3,YSCD,1,"
|
|---|
| 30 | S DIWESUB="Current Meds & Source",DIWEPSE=1
|
|---|
| 31 | W !!,"CURRENT MEDS AND SOURCE: "
|
|---|
| 32 | D ENDTM^YSUTL S DWPK=1 D EN^DIWE
|
|---|
| 33 | I '($D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,3,YSCD,1,1,0))#2) K ^PTX(YSDFN,YSHX,YSIDT,1,DUZ,3,YSCD,1,0) G DC
|
|---|
| 34 | L +^PTX(YSDFN) S:'$D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,0)) ^(0)=DUZ S ^(3,0)="^99.11D^1^1" S:'$D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,3,YSCD,0)) ^(0)=YSDTM L -^PTX(YSDFN)
|
|---|
| 35 | DC ;
|
|---|
| 36 | I '$D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,1,YSCD,1,1,0))&('$D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,2,YSCD,1,1,0)))&('$D(^PTX(YSDFN,YSHX,YSIDT,1,DUZ,3,YSCD,1,1,0))) K ^PTX(YSDFN,YSHX,YSIDT,1,DUZ)
|
|---|
| 37 | I '$O(^PTX(+YSDFN,YSHX,YSIDT,1,0)) L +^PTX(+YSDFN) K ^PTX(+YSDFN,YSHX,YSIDT) L -^PTX(+YSDFN) G END:$G(X)["^",1
|
|---|
| 38 | I '$D(^PTX(YSDFN,0)) L +^PTX(+YSDFN) S ^PTX(YSDFN,0)=YSDFN,^PTX("B",YSDFN,YSDFN)="" L -^PTX(YSDFN)
|
|---|
| 39 | L +^PTX(0) S YSTN=$P(^PTX(0),U,4)+1,L=$P(^PTX(0),U,3)
|
|---|
| 40 | S L=$S(YSDFN>L:YSDFN,1:L),^PTX(0)=$P(^PTX(0),U,1,2)_U_L_U_YSTN L -^PTX(0) K L,YSTN
|
|---|
| 41 | L +^PTX(YSDFN)
|
|---|
| 42 | I $D(^PTX(YSDFN,YSHX,0)) S YSNU=$P(^(0),U,4)+1,^(0)=$P(^(0),U,1,3)_U_YSNU K YSNU
|
|---|
| 43 | E S ^(0)="^99.05D^"_YSIDT_"^1"
|
|---|
| 44 | S:'$D(^PTX(YSDFN,YSHX,YSIDT,0)) ^(0)=DT
|
|---|
| 45 | I $D(^PTX(YSDFN,YSHX,YSIDT,1,0)) S YSUR=$P(^(0),U,3),YSUR=$S(DUZ>YSUR:DUZ,1:YSUR),YSNU=$P(^(0),U,4)+1,^(0)=$P(^(0),U,1,2)_U_YSUR_U_YSNU K YSUR,YSNU
|
|---|
| 46 | E S ^(0)="^99.06P^"_DUZ_"^1"
|
|---|
| 47 | L -^PTX(YSDFN) G END:$G(X)="^",1
|
|---|
| 48 | END ; Called by routine YSHX1R
|
|---|
| 49 | I $G(YSTOUT),IOST?1"C-".E W:IOF]"" @IOF
|
|---|
| 50 | K %,%DT,A,A1,B4,C,D,DIC,DIW,DIWEPSE,DIWF,DIWL,DIWR,DIWT,DN,YSDT(0),YSDT(1),DW2,DWI,DXS,I,I0,IO("Q"),J,K,M,P,X,X1,Y,YSAGE,YSCD,YSCON,YSDFN,YSDOB,YSDTM,YSFTR,YSHD,YSFHDR,YSHR,YSHX,YSIDT
|
|---|
| 51 | K YSLFT,YSMN,YSNM,YSNH,YSP0,YSPF,YSPT,YSPTD,YSSEX,YSSL,YSSSN,YSTM,YSTOUT,YSUOUT,YSUS,YSUSN,YSUSER,YSUTL,YSYD,Z,ZTSK Q
|
|---|
| 52 | DTS ;
|
|---|
| 53 | S (YSTOUT,YSUOUT)=0 I '$D(^PTX(YSDFN,"HX")) S YSNH=1 W $C(7),!!?3,"NO HX1'S ON FILE",!! Q
|
|---|
| 54 | S (YSNH,K,YSIDT)=0 K A W !!?10,"PREVIOUS HX1'S",!
|
|---|
| 55 | YSIDT ;
|
|---|
| 56 | S YSIDT=$O(^PTX(YSDFN,YSHX,YSIDT)) G:'YSIDT SEL S K=K+1,YSHD=9999999-YSIDT,(Y,A(K))=YSHD
|
|---|
| 57 | D ENDD^YSUTL W !?8,$J(K,3)," ",Y G YSIDT
|
|---|
| 58 | SEL ;
|
|---|
| 59 | I K>1 G SL1
|
|---|
| 60 | I K=1 W !?10,Y R " OK? Y// ",AA:DTIME S YSTOUT='$T,YSUOUT=AA["^"
|
|---|
| 61 | G END:YSTOUT Q:YSUOUT
|
|---|
| 62 | S AA=$TR(AA,"yn","YN") S:AA="" AA="Y" G:AA="?" SELQ1 G:AA["??" SELQ2 S AA=$E(AA) I AA="Y" S YSDT=A(K) Q
|
|---|
| 63 | I K=1 S:"N"[AA YSNH=1 Q
|
|---|
| 64 | I K=1 W:AA'["?" " ?",$C(7) G SELQ1
|
|---|
| 65 | SL1 ;
|
|---|
| 66 | W !!?3,"Select HX1 NUMBER: " R AB:DTIME S YSOUT='$T,YSUOUT=AB["^" I YSTOUT G END
|
|---|
| 67 | Q:YSUOUT!(AB']"") G:AB["?" SL1Q I AB<1!(AB>K) G SL1
|
|---|
| 68 | S YSDT=A(AB) Q
|
|---|
| 69 | SELQ1 ;
|
|---|
| 70 | W !!,"""YES"" = edit. ""N"" = new. Only one HX1 per day.",! K AA G SEL
|
|---|
| 71 | SELQ2 ;
|
|---|
| 72 | W !!,"""YES"" permits altering of previously entered information.",!,"""NO"" allows the addition of a new history - only 1 per day.",! K AA G SEL
|
|---|
| 73 | SL1Q ;
|
|---|
| 74 | W !!,"Enter number of HX1 you wish to edit OR a "" to enter a new HX1.",!,"Only one HX1 may be entered per day.",! G SL1
|
|---|
| 75 | ELQ ;
|
|---|
| 76 | W !!,"""E"" permits altering or addition of new HX1.",!,"""P"" produces a report.",!,"""Q"" exits option.",! G EL
|
|---|
