source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQPXRM2.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 
1YTQPXRM2 ;ALB/ASF- MHA3 API FOR CLINICAL REMINDERS ; 7/27/07 1:25pm
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
3 ;Reference to ^PXRMINDX(601.2, supported by DBIA #4114
4 ;Reference to ^PXRMINDX(601.84, supported by DBIA #??????
5 Q
6PTTEST(YSDATA,YS) ;all data scores for a specific patient
7 ;Input:
8 ;YS("DFN"): Patient IFN from file2
9 ;YS("CODE"): Test code NUMBER from file 601.71 including "ASI","GAF"
10 ;YS("BEGIN"): inclusive date in %DT acceptable format (11/11/2011) to begin search [optional]
11 ;YS("END"): inclusive date in %DT acceptable format (11/11/2011) to end search [optional]
12 ;YS("LIMIT"): Last N administrations [optional]
13 ;Output
14 ;YSDATA(1)=[DATA]^NUMBER FOUND
15 ;YSDATA(OCCURANCE,1:999) most recent to least recent occurance for this test for this patient
16 N YSBEG,YSCODE,R1,R2,R3,YSADATE,YSEND,YSLIMIT,YSLM,YSOCC,YSSCALE,YSSTAFF,YSZ,YSZN,G,YSORT,YSCODEN,YS601,%DT,DAS,DFN,IFN,NI,N,N1,N2,YSID,X,Y,YSNEG,YSDFN
17 K ^TMP($J,"YSG"),YSDATA
18 D PARSE(.YS)
19 I YSLM'?1NP.N!(YSLM=0) S YSDATA(1)="[ERROR]",YSDATA(2)="bad limit" Q ;-->out
20 I YSLM>0 S YSNEG=0,YSORT=-1
21 E S YSLM=YSLM*-1,YSNEG=1,YSORT=1
22 I YSCODE="ASI" D ASIPT Q ;-->out
23 I YSCODE="GAF" D GAFPT Q ;-->out
24 D P1,PA
25 S NI=0
26 I YSNEG=0 S N=9999999 F S N=$O(^TMP($J,"YSG",N),-1) Q:N=""!(NI=YSLM) D
27 . S N2=9999999 F S N2=$O(^TMP($J,"YSG",N,N2),-1) Q:N2=""!(NI=YSLM) S NI=NI+1,YSDATA(NI+1)=^TMP($J,"YSG",N,N2)
28 I YSNEG=1 S N=0 F S N=$O(^TMP($J,"YSG",N)) Q:N=""!(NI=YSLM) D
29 . S N2=0 F S N2=$O(^TMP($J,"YSG",N,N2)) Q:N2="" S NI=NI+1,YSDATA(NI+1)=^TMP($J,"YSG",N,N2)
30 S YSDATA(1)="[DATA]"_U_NI
31 K ^TMP($J,"YSG"),YS
32 Q
33PA ;MHA3 DATA
34 I YSNEG=0 S YSID=YSEND+.00001
35 E S YSID=YSBEG-.00001
36 S NI=0
37 F S YSID=$O(^PXRMINDX(601.84,"PI",DFN,YSCODEN,YSID),YSORT) Q:(YSID'>0)!(YSID<YSBEG)!(YSID>YSEND) D
38 . S DAS=0 F S DAS=$O(^PXRMINDX(601.84,"PI",DFN,YSCODEN,YSID,DAS)) Q:DAS'>0!(NI=YSLM) D
39 .. S NI=NI+1
40 .. S ^TMP($J,"YSG",YSID,NI)=DAS_U_YSID_"^601.84"
41 Q
42P1 ;old 601.2 data
43 I YSNEG=0 S YSID=YSEND+.00001
44 E S YSID=YSBEG-.00001
45 S NI=0
46 S YS601=$O(^YTT(601,"B",YSCODE,0))
47 Q:YS601="" ;-->out ASF 2/23/07
48 F S YSID=$O(^PXRMINDX(601.2,"PI",DFN,YS601,YSID),YSORT) Q:(YSID'>0)!(YSID<YSBEG)!(YSID>YSEND)!(NI=YSLM) D
49 . S DAS=DFN_";1;"_YS601_";1;"_YSID
50 . S NI=NI+1
51 . S ^TMP($J,"YSG",YSID,NI)=DAS_U_YSID_"^601.2"
52 Q
53PARSE(YS) ; -- array parsing
54 S DFN=$G(YS("DFN"))
55 S (YSCODEN,YSCODE)=$G(YS("CODE"))
56 S YSCODE=$P($G(^YTT(601.71,YSCODEN,0),"ERROR"),U)
57 S YSADATE=$G(YS("ADATE")) S X=YSADATE,%DT="T" D ^%DT S YSADATE=Y
58 S YSSCALE=$G(YS("SCALE"))
59 S YSBEG=$G(YS("BEGIN")) S:YSBEG="" YSBEG="01/01/1970" S X=YSBEG,%DT="T" D ^%DT S YSBEG=Y\1
60 S YSEND=$G(YS("END")) S:YSEND="" YSEND="01/01/2099" S X=YSEND,%DT="T" D ^%DT S YSEND=Y
61 S YSLM=$G(YS("LIMIT"),1)
62 Q
63GAFPT ;gaf for pt IN time
64 S YS601=$O(^YTT(601,"B","GAF",0))
65 S IFN=$S(YSORT=1:0,1:9999999),NI=0
66 K ^TMP($J,"YSGAF")
67 F S IFN=$O(^YSD(627.8,"C",DFN,IFN),YSORT) Q:(IFN'>0)!(NI=YSLM) D
68 . S X=$P($G(^YSD(627.8,IFN,60)),U,3)
69 . Q:X=""
70 . S X=$P($G(^YSD(627.8,IFN,0)),U,3)
71 . Q:(X<YSBEG)!(X>YSEND)
72 . S NI=NI+1
73 . S ^TMP($J,"YSGAF",X,IFN)=""
74 S X=$S(YSORT=1:0,1:9999999)
75 F S X=$O(^TMP($J,"YSGAF",X),YSORT) Q:X'>0 S IFN=0 F S IFN=$O(^TMP($J,"YSGAF",X,IFN)) Q:IFN'>0 D
76 . S YSOCC=$O(YSDATA(9999999),-1)+1 S:YSOCC<2 YSOCC=2
77 . S DAS=DFN_";1;"_YS601_";1;"_IFN
78 . S YSDATA(YSOCC)=DAS_U_X_"^627.8"
79 S YSDATA(1)="[DATA]"_U_NI
80 Q
81ASIPT ;asis for pt IN time
82 S YS601=$O(^YTT(601,"B","ASI",0))
83 S IFN=$S(YSORT=1:0,1:9999999),NI=0
84 F S IFN=$O(^YSTX(604,"C",DFN,IFN),YSORT) Q:IFN'>0!(NI=YSLM) D
85 . Q:'$D(^YSTX(604,IFN,.5)) ; no sig
86 . S X=$P($G(^YSTX(604,IFN,0)),U,5)
87 . Q:X=""
88 . Q:(X<YSBEG)!(X>YSEND)
89 . S YSOCC=$O(YSDATA(9999999),-1)+1 S:YSOCC<2 YSOCC=2
90 . S NI=NI+1
91 . S DAS=DFN_";1;"_YS601_";1;"_IFN
92 . S YSDATA(YSOCC)=DAS_U_X_"^604"
93 S YSDATA(1)="[DATA]"_U_NI
94 Q
Note: See TracBrowser for help on using the repository browser.