source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDX3R1.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1YSDX3R1 ;SLC/DJP/LJA-Print of DXLS History for the Mental Health Medical Record ;12/17/93 11:31
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 ; Called from the top by MENU option YSDIAGP-DXLS
5 ;D RECORD^YSDX0001("YSDX3R1^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
6 ;
7ENTRY ;
8 ;D RECORD^YSDX0001("ENTRY^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
9 W @IOF W !!?IOM-$L("DXLS HISTORY")\2," DXLS HISTORY ",!!
10 D ^YSLRP I YSTOUT!YSUOUT!(YSDFN'>0) D END Q
11 I '$D(^YSD(627.8,"AD",YSDFN)) W !!?10,"No history on file for ",YSNM D END Q
12DEVICE ;
13 ;D RECORD^YSDX0001("DEVICE^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
14 K IOP S %ZIS="Q" D ^%ZIS Q:POP
15 I $D(IO("Q")) S ZTRTN="ENPR^YSDX3R1",(ZTSAVE("A"),ZTSAVE("YS*"))="",ZTDESC="YS DXLS PRINT" D ^%ZTLOAD Q
16 ;
17ENPR ;Entry to core of print program.
18 ;D RECORD^YSDX0001("ENPR^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
19 S YSFHDR="DXLS HISTORY LIST" S YSPP=0
20PR ;
21 ;D RECORD^YSDX0001("PR^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
22 U IO D:'$D(YSNOFORM) ENHD^YSFORM S Y1=0,YST=$S(IOST?1"P".E:1,1:0),YSSL=$S(YST:8,1:3),YSLFT=0
23 W !!,"Prinicipal Diagnosis (DXLS): "
24 S YSLFT=0
25 S J=0 F S J=$O(^YSD(627.8,"AH",+YSDFN,J)) QUIT:'J!(YSLFT) D
26 . S J1=0
27 . F S J1=$O(^YSD(627.8,"AH",+YSDFN,+J,J1)) QUIT:J1'>0!(YSLFT) D DXLS
28 D FINISH
29 I YST=1 D ENFT^YSFORM Q:YSPP
30END ;
31 ;D RECORD^YSDX0001("END^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
32 K A,A1,A2,A3,A4,A5,A6,A7,A8,G,G1,G2,G3,G4,G5,G6,G11,J,J5,J50,K,L,L1
33 K L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,W,YSMOD,YSDXNN,YSDXN,YSML
34 K YSDXDT,YSDFN,YSAUTH,YSCD,YSCOND,YSDOB,YSDTM,YSDXS,YSFHDR
35 K YSFTR,YSLC,YSLFT,YSCON,YSNM,YSPP,YSPS,YSSL,YSSSN,YSSTOP
36 K YST,YSTM,YSAGE,YSDUZ,YSSEX,YSQT,DIWF,DIWR,DIWL
37 D ^%ZISC,KILL^%ZTLOAD
38 QUIT
39DXLS ;
40 ;D RECORD^YSDX0001("DXLS^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
41 N YSDXI
42 I $Y+YSSL+4>IOSL D CK^YSDX3RU Q:YSTOUT!YSUOUT!YSTOUT ;->
43 ;
44 ; J2=Diagnosis variable pointer Y=Date/time of Diagnosis
45 S J2=$P(^YSD(627.8,J1,1),U),Y=$P(^(0),U,3) D DD^%DT S YSDXLSD=Y
46 ;
47 ; J5=Full global reference to pointed to Diagnosis
48 S J3=$P(J2,";",2),J4=$P(J2,";"),J5="^"_J3_J4_","_0_")"
49 ;
50 ; J50=0 node of pointed to Diagnosis
51 S J50=@J5
52 ;
53 ; If DSM...
54 I J3="YSD" D
55 S YSDXLSN=$G(^YSD(627.7,+J4,"D")) ; Diagnosis name
56 S YSDXLS=$P(J50,U) ; ICD Code#
57 ;
58 ; If ICD9...
59 I J3["ICD9(" D
60 . S YSDXLSN=$P(J50,U,3) ; Diagnosis (free text)
61 . S YSDXLS=$P(J50,U) ; ICD Code#
62 ;
63 ; Do MODIFIERs exist?
64 I $D(^YSD(627.8,J1,5)) D
65 . S YSML=$P(^YSD(627.8,J1,5,0),U,3) ; Last IEN for MODIFIERs multiple
66 . F YSDXI=1:1:YSML D ; Loop thru each multiple entry
67 . . S M1=$G(^YSD(627.8,J1,5,+YSDXI,0)) ; MODIFIER's 0 node
68 . . QUIT:M1']"" ;->
69 . . S YSMOD(+YSDXI)=$P(M1,U,3) ; 'Stands For'
70 . . K M1
71AUTH ;
72 ;D RECORD^YSDX0001("AUTH^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
73 S J6=+$P(^YSD(627.8,J1,0),U,4) ; Diagnosis by
74 S J7=$P(^VA(200,+J6,0),U) ; Name of diagnoser
75 S J8=$P($G(^VA(200,J6,0)),U,9) ; Title pointer
76 S:J8]"" J8=$P(^DIC(3.1,J8,0),U) ; Title file
77 S YSAUTH=J7_" "_J8
78 QUIT:'$D(YSDXLS) ;->
79 W !!?3,YSDXLS_" "_$E(YSDXLSN,1,65)
80 I $D(YSMOD) F YSDXI=1:1:YSML I $D(YSMOD(YSDXI)) W:$TR(YSMOD(YSDXI)," ","")]"" !?8,"---"_YSMOD(YSDXI)
81COMMENT ;
82 ;D RECORD^YSDX0001("COMMENT^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
83 I $D(^YSD(627.8,J1,80,0)) D
84 . W !?9,"Comments: ",!
85 . S DIWL=18,DIWR=75,DIWF="W" K ^UTILITY($J,"W")
86 . S K=0 F S K=$O(^YSD(627.8,J1,80,K)) Q:'K S X=^(K,0) D ^DIWP
87 I $D(K),K<1 D ^DIWW K ^UTILITY($J,"W")
88 W !?9,"Entered by: ",YSAUTH,!?9,"Dated ",YSDXLSD,!
89 QUIT
90 ;
91FINISH ;
92 ;D RECORD^YSDX0001("FINISH^YSDX3R1") ;Used for testing. Inactivated in YSDX0001...
93 K J1,J2,J3,J4,J5,J6,YSDXLSN,YSDXLS,YSDXLSD,YSMOD
94 QUIT
95 ;
Note: See TracBrowser for help on using the repository browser.