Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTAPI10A

YTAPI10A.m

Go to the documentation of this file. 
  1. YTAPI10A ;ALB/ASF- PSYCH TEST API FOR CLINICAL REMINDERS ;09/20/2004
  1.  ;;5.01;MENTAL HEALTH;**77**;Dec 30, 1994
  1.  ;Reference to ^PXRMINDX(601.2, supported by DBIA #4114
  1. SET(X) ;
  1.  S N=N+1
  1.  S YSSUB(N)=X
  1.  Q
  1. OCCUR(YSSUB,YS) ;occurances OF TESTS,GAF,ASI
  1.  ;Input:
  1.  ;YS("CODE"): Test code NUMBER from file 601 including "ASI","GAF"
  1.  ;YS("BEGIN"): inclusive date in %DT acceptable format (11/11/2011) to begin search [optional]                
  1.  ;YS("END"): inclusive date in %DT acceptable format (11/11/2011) to end search  [optional]           
  1.  ;YS("LIMIT"): Last N administrations [optional]
  1.  ;Output
  1.  ;^TMP($J,YSSUB,1)=[DATA]^NUMBER FOUND
  1.  ;^TMP($J,YSSUB,DFN,OCCURANCE)=DAS^DFN^TEST (DAS=entry endas^ytapi10)
  1.  N G,YSLIMIT,YSJJ,YSSONE,S,R,N,YSN2,N4,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND,YSAA,DAS,YSOCC,YSZN,YST,YSLM
  1.  N IFN,R1,R2,R3,SFN1,SFN2,YSBEG,YSCK,YSDFN,YSED,YSIFN,YSINUM,YSITEM,YSN2,YSNODE,YSPRIV,YSQT,YSR,YSSTAFF,YSTYPE,YSCODE,NI,YSID
  1.  D PARSE^YTAPI(.YS)
  1.  S YSLM=$G(YS("LIMIT")) S:YSLM'?1N.N YSLM=1
  1.  S N=0
  1.  K ^TMP($J,YSSUB)
  1.  I '$D(^YTT(601,"B",YSCODE)) S ^TMP($J,YSSUB,1)="[ERROR]^BAD TEST CODE #" Q  ;-->out
  1.  S YSCODE=$O(^YTT(601,"B",YSCODE,0))
  1.  I $P(^YTT(601,YSCODE,0),U)="ASI" D ASIOC Q  ;-->out
  1.  I $P(^YTT(601,YSCODE,0),U)="GAF" D GAFOC Q  ;-->out
  1. P0 S DFN=0,NI=0 F  S DFN=$O(^PXRMINDX(601.2,"IP",YSCODE,DFN)) Q:DFN'>0  S YS("DFN")=DFN D P1
  1.  S ^TMP($J,YSSUB)="[DATA]"_U_NI
  1.  Q
  1. P1 I $D(^YTT(601,YSCODE)) S YSN2=YSEND+.1,YSOCC=0 F  S YSN2=$O(^YTD(601.2,DFN,1,YSCODE,1,YSN2),-1) Q:YSN2'>0!(YSN2<YSBEG)  D
  1.  . S YSOCC=YSOCC+1
  1.  . Q:(YSOCC>YSLM)
  1.  . S NI=NI+1
  1.  . S ^TMP($J,YSSUB,DFN,YSOCC)=DFN_";1;"_YSCODE_";1;"_YSN2_U_YSN2_U_YSCODE
  1.  Q
  1. GAFOC ;all axis5 DXs in time frame
  1.  S YST=YSEND+.0000001,NI=0
  1.  F  S YST=$O(^YSD(627.8,"B",YST),-1) Q:YST'>0!(YST<YSBEG)  S IFN=0 F  S IFN=$O(^YSD(627.8,"B",YST,IFN)) Q:IFN'>0  D
  1.  . S X=$P($G(^YSD(627.8,IFN,60)),U,3)
  1.  . Q:X=""
  1.  . S DFN=$P($G(^YSD(627.8,IFN,0)),U,2) Q:DFN'>0  ;bad dfn
  1.  . S YSOCC=$O(^TMP($J,YSSUB,DFN,999999),-1)+1
  1.  . Q:(YSOCC>YSLM)
  1.  . S NI=NI+1
  1.  . S ^TMP($J,YSSUB,DFN,YSOCC)=DFN_";1;"_YSCODE_";1;"_IFN_U_YST_U_YSCODE
  1.  S ^TMP($J,YSSUB)="[DATA]"_U_NI
  1.  Q
  1. ASIOC ;
  1.  S NI=0,DFN=0,YSID=YSEND+.01
  1.  F  S YSID=$O(^YSTX(604,"AD",YSID),-1) Q:(YSID'>0)!(YSID<YSBEG)  S IFN=0 F  S IFN=$O(^YSTX(604,"AD",YSID,IFN)) Q:IFN'>0  D
  1.  . Q:'$D(^YSTX(604,IFN,.5))  ; no sig
  1.  . S G=$G(^YSTX(604,IFN,0))
  1.  . S DFN=$P(G,U,2) Q:DFN'>0  ;bad dfn
  1.  . S YSOCC=$O(^TMP($J,YSSUB,DFN,999999),-1)+1
  1.  . Q:(YSOCC>YSLM)
  1.  . S NI=NI+1
  1.  . S ^TMP($J,YSSUB,DFN,YSOCC)=DFN_";1;"_YSCODE_";1;"_IFN_U_$P(G,U,5)_U_Y
  1.  S ^TMP($J,YSSUB)="[DATA]"_U_NI
  1.  Q
  1. PTTEST(YSDATA,YS) ;all data scores for a specific patient
  1.  ;Input:
  1.  ;YS("DFN"): Patient IFN from file2
  1.  ;YS("CODE"): Test code NUMBER from file 601 including "ASI","GAF"
  1.  ;YS("BEGIN"): inclusive date in %DT acceptable format (11/11/2011) to begin search [optional]                
  1.  ;YS("END"): inclusive date in %DT acceptable format (11/11/2011) to end search  [optional]           
  1.  ;YS("LIMIT"): Last N administrations [optional]
  1.  ;Output
  1.  ;YSDATA(1)=[DATA]^NUMBER FOUND
  1.  ;YSDATA(OCCURANCE,1:999) most recent to least recent occurance for this test for this patient
  1.  N YSBEG,YSCODE,R1,R2,R3,YSADATE,YSEND,YSLIMIT,YSLM,YSOCC,YSSCALE,YSSTAFF,YSZ,YSZN,G,YSORT
  1.  D PARSE^YTAPI(.YS)
  1.  S YSLM=$G(YS("LIMIT")) S:YSLM="" YSLM=1
  1.  I YSLM'?1NP.N!(YSLM=0) S YSDATA(1)="[ERROR]",YSDATA(2)="bad limit" Q  ;-->out
  1.  S YSORT=$S(YSLM<0:1,1:-1) ;set sort order
  1.  I YSLM>0 S YSID=YSEND+.00001
  1.  E  S YSID=YSBEG-.00001,YSLM=YSLM*-1
  1.  I YSCODE="ASI" D ASIPT Q  ;-->out
  1.  I YSCODE="GAF" D GAFPT Q  ;-->out
  1.  S YSCODE=$O(^YTT(601,"B",YSCODE,0))
  1.  S NI=0
  1.  F  S YSID=$O(^PXRMINDX(601.2,"PI",DFN,YSCODE,YSID),YSORT) Q:(YSID'>0)!(YSID<YSBEG)!(YSID>YSEND)!(NI=YSLM)  D
  1.  . S DAS=DFN_";;"_YSCODE_";;"_YSID
  1.  . S DAS=DFN_";1;"_YSCODE_";1;"_YSID
  1.  . S YSOCC=$O(YSDATA(9999999),-1)+1 S:YSOCC<2 YSOCC=2
  1.  . S YSDATA(YSOCC)=DAS_U_YSID,NI=NI+1
  1.  S YSDATA(1)="[DATA]"_U_NI
  1.  Q
  1. GAFPT ;gaf for pt IN time
  1.  S IFN=$S(YSORT=1:0,1:9999999),NI=0
  1.  K ^TMP($J,"YSGAF")
  1.  S YSCODE=$O(^YTT(601,"B","GAF",0))
  1.  F  S IFN=$O(^YSD(627.8,"C",DFN,IFN),YSORT) Q:(IFN'>0)!(NI=YSLM)  D
  1.  . S X=$P($G(^YSD(627.8,IFN,60)),U,3)
  1.  . Q:X=""
  1.  . S X=$P($G(^YSD(627.8,IFN,0)),U,3)
  1.  . Q:(X<YSBEG)!(X>YSEND)
  1.  . S NI=NI+1
  1.  . S ^TMP($J,"YSGAF",X,IFN)=""
  1.  S X=$S(YSORT=1:0,1:9999999)
  1.  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
  1.  . S YSOCC=$O(YSDATA(9999999),-1)+1 S:YSOCC<2 YSOCC=2
  1.  . S DAS=DFN_";1;"_YSCODE_";1;"_IFN
  1.  . S YSDATA(YSOCC)=DAS_U_X
  1.  S YSDATA(1)="[DATA]"_U_NI
  1.  Q
  1. ASIPT ;asis for pt IN time
  1.  S IFN=$S(YSORT=1:0,1:9999999),NI=0
  1.  S YSCODE=$O(^YTT(601,"B","ASI",0))
  1.  F  S IFN=$O(^YSTX(604,"C",DFN,IFN),YSORT) Q:IFN'>0!(NI=YSLM)  D
  1.  . Q:'$D(^YSTX(604,IFN,.5))  ; no sig
  1.  . S X=$P($G(^YSTX(604,IFN,0)),U,5)
  1.  . Q:X=""
  1.  . Q:(X<YSBEG)!(X>YSEND)
  1.  . S YSOCC=$O(YSDATA(9999999),-1)+1 S:YSOCC<2 YSOCC=2
  1.  . S NI=NI+1
  1.  . S DAS=DFN_";1;"_YSCODE_";1;"_IFN
  1.  . S YSDATA(YSOCC)=DAS_U_X
  1.  S YSDATA(1)="[DATA]"_U_NI
  1.  Q