| [613] | 1 | YTQTIU ;ASF/ALB- MHAX TIU ;2/14/05 6:57pm ; 10/30/07 11:15am
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
|
|---|
| 3 | Q
|
|---|
| 4 | PCREATE(YSDATA,YS) ;pn creation
|
|---|
| 5 | ;Input AD AS ien of 601.84 mh administration
|
|---|
| 6 | ; YS(1...X) as text of note
|
|---|
| 7 | N DFN,N,N1,N2,Y,YSAD,YSAVED,YSENC,YSHOSP,YSOK,YSORD,YSRPRIVL,YST,YSTIT,YSTS,YSVISIT,YSVSIT,YSVSTR,YST1,YSTIUX,YSTIUDA
|
|---|
| 8 | N VA,VADM,X,YSAGE,YSB,YSDOB,YSG,YSHDR,YSNM,YSSEX,YSSSN
|
|---|
| 9 | S YSTIUDA=$G(YS("TIUIEN"),0)
|
|---|
| 10 | S YSDATA(1)="[ERROR]"
|
|---|
| 11 | S YSAD=$G(YS("AD"),0)
|
|---|
| 12 | I '$D(^YTT(601.84,YSAD,0)) S YSDATA(2)="bad ad" Q ;-->out
|
|---|
| 13 | S YSHOSP=$P(^YTT(601.84,YSAD,0),U,11)
|
|---|
| 14 | I YSHOSP'>0 S YSDATA(2)="no location" Q ;-->out
|
|---|
| 15 | S DFN=$$GET1^DIQ(601.84,YSAD_",",1,"I")
|
|---|
| 16 | I DFN'>0 S YSDATA(2)="bad dfn" Q ;-->out
|
|---|
| 17 | S YSAVED=$$GET1^DIQ(601.84,YSAD_",",4,"I")
|
|---|
| 18 | S YSORD=$$GET1^DIQ(601.84,YSAD_",",5,"I")
|
|---|
| 19 | S Y=$$WHATITLE^TIUPUTU("MENTAL HEALTH DIAGNOSTIC STUDY")
|
|---|
| 20 | I Y'>0 S Y=$$WHATITLE^TIUPUTU("MHA ASSESSMENT NOTE")
|
|---|
| 21 | I Y'>0 S YSDATA(2)="pn not setup" Q ;--->out
|
|---|
| 22 | S YSTIT=+Y
|
|---|
| 23 | S YSTS=$$GET1^DIQ(601.84,YSAD_",",2,"I")
|
|---|
| 24 | S YSRPRIVL=$$GET1^DIQ(601.71,YSTS_",",9,"E")
|
|---|
| 25 | Q:YSRPRIVL'="" ;-->out ASF 5/1/07
|
|---|
| 26 | D DEM^VADPT,PID^VADPT S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID")
|
|---|
| 27 | S $P(YSHDR," ",60)="",YSHDR=YSSSN_" "_YSNM_YSHDR,YSHDR=$E(YSHDR,1,44)_YSSEX_" AGE "_YSAGE
|
|---|
| 28 | I YSTIUDA>0 D UPDATE Q ;-->out
|
|---|
| 29 | D TXTCK(0)
|
|---|
| 30 | ;
|
|---|
| 31 | ;MAKE(SUCCESS,DFN,TITLE,VDT,VLOC,VSIT,TIUX,VSTR,SUPPRESS,NOASF)
|
|---|
| 32 | D MAKE^TIUSRVP(.YSOK,DFN,YSTIT,YSAVED,YSHOSP,,.YSTIUX,YSHOSP_";"_YSAVED_";E")
|
|---|
| 33 | Q:YSOK'>0 ;-->out
|
|---|
| 34 | S YSDATA(1)="[DATA]",YSDATA(2)=YSOK
|
|---|
| 35 | S YSVISIT=$$GET1^DIQ(8925,YSOK_",",.03,"I")
|
|---|
| 36 | S ^TMP("YSENC",$J,"ENCOUNTER",1,"ENC D/T")=YSAVED
|
|---|
| 37 | S ^TMP("YSENC",$J,"ENCOUNTER",1,"HOS LOC")=YSHOSP
|
|---|
| 38 | S ^TMP("YSENC",$J,"ENCOUNTER",1,"PATIENT")=DFN
|
|---|
| 39 | S ^TMP("YSENC",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="E"
|
|---|
| 40 | S ^TMP("YSENC",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="O"
|
|---|
| 41 | S ^TMP("YSENC",$J,"PROCEDURE",1,"ENC PROVIDER")=YSORD
|
|---|
| 42 | S ^TMP("YSENC",$J,"PROCEDURE",1,"EVENT D/T")=YSAVED
|
|---|
| 43 | S ^TMP("YSENC",$J,"PROVIDER",1,"NAME")=YSORD
|
|---|
| 44 | S ^TMP("YSENC",$J,"PROVIDER",1,"PRIMARY")=1
|
|---|
| 45 | S YSENC=$$DATA2PCE^PXAPI("^TMP(""YSENC"",$J)",19,"MHA DATA",.YSVISIT,"^TMP(""YSENC"",$J")
|
|---|
| 46 | K ^TMP("YSENC",$J)
|
|---|
| 47 | Q
|
|---|
| 48 | UPDATE ;
|
|---|
| 49 | K ^TMP("TUIVIEW",$J)
|
|---|
| 50 | D TGET^TIUSRVR1(.YST1,YSTIUDA)
|
|---|
| 51 | S N1=4,N2=0 ;keep from adding header each time
|
|---|
| 52 | F S N1=$O(^TMP("TIUVIEW",$J,N1)) Q:N1'>0 S N2=N2+1,YSTIUX("TEXT",N2,0)=^TMP("TIUVIEW",$J,N1)
|
|---|
| 53 | K ^TMP("TUIVIEW",$J)
|
|---|
| 54 | S YSTIUX(.02)=DFN
|
|---|
| 55 | S YSTIUX(1301)=YSAVED
|
|---|
| 56 | S YSTIUX(1302)=YSORD
|
|---|
| 57 | S $P(X,"_",75)=""
|
|---|
| 58 | S N2=N2+1,YSTIUX("TEXT",N2,0)=X
|
|---|
| 59 | D TXTCK(N2)
|
|---|
| 60 | D UPDATE^TIUSRVP(.YSOK,YSTIUDA,.YSTIUX)
|
|---|
| 61 | S:YSOK YSDATA(1)="[DATA]",YSDATA(2)=YSOK
|
|---|
| 62 | Q
|
|---|
| 63 | TXTCK(N2) ;clean text
|
|---|
| 64 | S N=0,N1=0 F S N=$O(YS(N)) Q:N'>0 D
|
|---|
| 65 | . S YSG=YS(N)
|
|---|
| 66 | . I YSG="" S YSB=$G(YSB)+1
|
|---|
| 67 | . E S YSB=0
|
|---|
| 68 | . I (YSG="")&(YSB>2) Q ;no print mult blanks
|
|---|
| 69 | . I N>3 Q:($E(YSG,1,51)=$E(YSHDR,1,51))
|
|---|
| 70 | . I N>3 Q:YSG?." "1"PRINTED ENTERED"." "
|
|---|
| 71 | . Q:YSG?1"Not valid unless signed: Reviewed by".E
|
|---|
| 72 | . Q:YSG?1"Printed by: ".E
|
|---|
| 73 | . S N1=N1+1
|
|---|
| 74 | . S YSTIUX("TEXT",N1+N2,0)=YS(N) K YS(N)
|
|---|
| 75 | Q
|
|---|
