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

YTQAPI4.m

Go to the documentation of this file.
  1. YTQAPI4 ;ASF/ALB MHQ REMOTE PROCEEDURES CHOICE/CHOICETYPE ; 4/3/07 1:44pm
  1. ;;5.01;MENTAL HEALTH;**85**;DEC 30,1994;Build 48
  1. Q
  1. IDENTAE(YSDATA,YS) ;choiceidentifier add/edit
  1. ;input:CT as Choicetype IEN
  1. ; ID a N,0 or 1
  1. ;Output: added or eddited
  1. N DA,YSID
  1. S YSCT=$G(YS("CT"))
  1. I YSCT'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad CT" Q ;-->out
  1. I '$D(^YTT(601.751,"B",YSCT)) S YSDATA(1)="[ERROR]",YSDATA(2)=YSCT_"^not found" Q ;-->out
  1. S YSID=$G(YS("ID"))
  1. I (YSID'="1")&(YSID'="0")&(YSID'="N") S YSDATA(1)="[ERROR]",YSDATA(1)="bad id" Q ;--out
  1. I $D(^YTT(601.89,"B",YSCT)) S DA=$O(^YTT(601.89,"B",YSCT,0)) S $P(^YTT(601.89,DA,0),U,2)=YSID,YSDATA(2)="eddited" Q ;good edit
  1. L +^YTT(601.89):30
  1. S DA=$$NEW^YTQLIB(601.89)
  1. S ^YTT(601.89,DA,0)=YSCT_U_YSID
  1. S DIK="^YTT(601.89,"
  1. D IX1^DIK
  1. L -^YTT(601.89)
  1. S YSDATA(1)="[DATA]",YSDATA(2)=DA_"^added"
  1. Q
  1. TESTADD(YSDATA,YS) ;add new instrument
  1. ;input:CODE must be unique
  1. ;Output: new ien^added
  1. N DA,YSCODE
  1. S YSCODE=$G(YS("CODE"))
  1. I ($L(YSCODE)>50)!($L(YSCODE)<3) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ins name" Q ;-->out
  1. I $D(^YTT(601.71,"B",YSCODE)) S DA=$O(^YTT(601.75,"B",YSCODE,0)),YSDATA(1)="[ERROR]",YSDATA(2)=DA_"^duplicate" Q ;-->out
  1. L +^YTT(601.71):30
  1. S DA=$$NEW^YTQLIB(601.71)
  1. S ^YTT(601.71,DA,0)=YSCODE
  1. S DIK="^YTT(601.71,"
  1. D IX1^DIK
  1. L -^YTT(601.71)
  1. S YSDATA(1)="[DATA]",YSDATA(2)=DA_"^added"
  1. Q
  1. ADDCH(YSDATA,YS) ; check, report, force add a choice
  1. N YSFORCE,YSTXT,YSIEN,DIK,DA,X,YSLEG
  1. S YSFORCE=$G(YS("FORCE"),"N")
  1. S YSTXT=$G(YS("TEXT"))
  1. S YSLEG=$G(YS("LEGACY"))
  1. I YSTXT="" S YSDATA(1)="[ERROR]",YSDATA(2)="no choice text" Q ;-->out
  1. I $D(^YTT(601.75,"C",YSTXT)) S YSIEN=$O(^YTT(601.75,"C",YSTXT,0)) S YSDATA(1)="[DATA]",YSDATA(2)=YSIEN_"^existed",YSDATA(3)=YSTXT Q ;--> out
  1. S X=YSTXT X ^DD("FUNC",13,1)
  1. I (YSFORCE'?1"Y".E)&($D(^YTT(601.75,"AU",X))) S YSIEN=$O(^YTT(601.75,"AU",X,0)),YSDATA(1)="[DATA]",YSDATA(2)=YSIEN_"^question force",YSDATA(3)=^YTT(601.75,YSIEN,1) Q ;-->out
  1. S DA=$$NEW^YTQLIB(601.75)
  1. L +^YTT(601.75,DA):30
  1. S ^YTT(601.75,DA,0)=DA,^YTT(601.75,DA,1)=YSTXT,$P(^YTT(601.75,DA,0),U,2)=YSLEG
  1. S DIK="^YTT(601.75," D IX1^DIK
  1. L -^YTT(601.75,DA)
  1. S YSDATA(1)="[DATA]",YSDATA(2)=DA_"^added",YSDATA(3)=YSTXT
  1. Q
  1. CTADD(YSDATA,YS) ;add new choicetype
  1. ;input: list of choice iens in numbered sequence ex YS(1)=3,YS(2)=22
  1. ;output NEW choice type number
  1. N YSI,YSERR,DA,YSFOUND,YSCTDA,YSCTX,I
  1. S YSERR=0 F YSI=1:1 Q:'$D(YS(YSI)) S:'$D(^YTT(601.75,YS(YSI),0)) YSERR=YSI_";"_$G(YS(YSI))
  1. I YSI=1 S YSDATA(1)="[ERROR]",YSDATA(2)="no choice list" Q ;-->out
  1. I YSERR'=0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad choice in list/"_YSERR Q ;-->out
  1. S YSDATA(1)="[DATA]",YSFOUND=0
  1. L +^YTT(601.751):30
  1. S YSCT=$O(^YTT(601.751,"B",""),-1)
  1. S YSCT=YSCT+1
  1. F YSI=1:1 Q:'$D(YS(YSI)) D
  1. . S DA=$$NEW^YTQLIB(601.751)
  1. . S ^YTT(601.751,DA,0)=YSCT_U_YSI_U_YS(YSI)
  1. . S DIK="^YTT(601.751,"
  1. . D IX1^DIK
  1. L -^YTT(601.751)
  1. S YSDATA(2)=YSCT_"^added"
  1. Q
  1. CKEX ;check for existing choiceType
  1. S YSCTDA=0
  1. F Q:YSFOUND>0 S YSCTDA=$O(^YTT(601.751,"ACT",YS(1),YSCTDA)) Q:YSCTDA'>0 S YSCTX=$P(^YTT(601.751,YSCTDA,0),U) D
  1. . S YSFOUND=0 F I=1:1 Q:'$D(YS(I)) S YSFOUND=$S($D(^YTT(601.751,"AC",YSCTX,I,YS(I))):YSFOUND+1,1:-999)
  1. S:YSFOUND>1 YSFOUND=YSCTX
  1. Q
  1. CTDEL(YSDATA,YS) ;delete a choicetype
  1. ;Input: CHOICETYPE
  1. ;output: DELETED if sucessful
  1. ; LIST OF question iens if in use
  1. N YSCT,DA,DIK,N
  1. S YSCT=$G(YS("CHOICETYPE"),0)
  1. I '$D(^YTT(601.751,"B",YSCT)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ct" Q ;-->out
  1. I $D(^YTT(601.72,"ACT",YSCT)) D S YSDATA(1)="[ERROR]" Q ;--> out
  1. . S N=1,YSQ=0 F S YSQ=$O(^YTT(601.72,"ACT",YSCT,YSQ)) Q:YSQ'>0 S N=N+1,YSDATA(N)=YSQ
  1. S DA=0,DIK="^YTT(601.751,"
  1. F S DA=$O(^YTT(601.751,"B",YSCT,DA)) Q:DA'>0 D ^DIK
  1. S YSDATA(1)="[DATA]",YSDATA(2)=YSCT_" deleted"
  1. Q
  1. CHFIND(YSDATA,YS) ;find a choice in choicetypes
  1. ;input CHOICE AS ien of 601.75
  1. ;output: list of CHOCIETYPE iens
  1. N YSCT,YSCH,N
  1. S YSCH=$G(YS("CHOICE"),0)
  1. I '$D(^YTT(601.75,YSCH,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad choice IEN" Q ;-->out
  1. S YSDATA(1)="[DATA]",YSDATA(2)="none found",YSCT=0,N=1
  1. F S YSCT=$O(^YTT(601.751,"ACT",YSCH,YSCT)) Q:YSCT'>0 S N=N+1,YSDATA(N)=YSCT
  1. Q
  1. CTDESC(YSDATA,YS) ;describe choicetype
  1. ;input; CHOICETYPE
  1. ;output: CHOICETYPE^choicetype ien^sequence^choice ien^choice text
  1. N YSCTN,YSCT,YSCH,N,YSQ,G
  1. S YSCT=$G(YS("CHOICETYPE"),0)
  1. I '$D(^YTT(601.751,"B",YSCT)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ct ien" Q ;-->out
  1. S YSCTN=0,N=1,YSDATA(1)="[DATA]"
  1. F S YSCTN=$O(^YTT(601.751,"B",YSCT,YSCTN)) Q:YSCTN'>0 D
  1. . S G=$G(^YTT(601.751,YSCTN,0))
  1. . S YSQ=$P(G,U,2),YSCH=$P(G,U,3)
  1. . S N=N+1,YSDATA(N)=YSCT_U_YSCTN_U_YSQ_U_YSCH_U
  1. . I YSCH?1N.N S YSDATA(N)=YSDATA(N)_$G(^YTT(601.75,YSCH,1))
  1. Q
  1. ORPHCT(YSDATA) ;find and delete orphan choiceTypes
  1. ;INPUT: none
  1. ;OUTPUT: list of choicetypes deleted
  1. N N,YSCT,YSDA,DA
  1. L ^YTT(601.751):30
  1. S YSCT=0,N=1,DIK="^YTT(601.751,",YSDATA(1)="[DATA]",YSDATA(2)="none"
  1. F S YSCT=$O(^YTT(601.751,"B",YSCT)) Q:YSCT'>0 I '$D(^YTT(601.72,"ACT",YSCT)) D
  1. . S YSDA=0 F S YSDA=$O(^YTT(601.751,"B",YSCT,YSDA)) Q:YSDA'>0 S N=N+1,YSDATA(N)=YSCT_U_YSDA,DA=YSDA D ^DIK
  1. L -^YTT(601.751)
  1. Q
  1. ORPHCH(YSDATA) ;find and delete orphan choices
  1. ;INPUT none
  1. ;OUTPUT list of choices deleted
  1. N N,YSCH,YSDA,DA
  1. L ^YTT(601.75):30
  1. S YSCH=0,N=1,YSDATA="[DATA]",YSDATA(2)="none",DIK="^YTT(601.75,"
  1. F S YSCH=$O(^YTT(601.75,YSCH)) Q:YSCH'>0 I '$D(^YTT(601.751,"ACT",YSCH)) D
  1. . S N=N+1,YSDATA(N)=YSCH,DA=YSCH D ^DIK
  1. L -^YTT(601.75)
  1. Q