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

YTQAPI2.m

Go to the documentation of this file. 
  1. YTQAPI2 ;ASF/ALB - MHAX REMOTE PROCEDURES cont ;10/17/16  13:37
  1.  ;;5.01;MENTAL HEALTH;**85,96,119,121,123,130,217,235,240**;Dec 30, 1994;Build 10
  1.  ;
  1.  ; Reference to ^DPT in ICR #10035
  1.  ; Reference to LIST^DIC in ICR #2051
  1.  ; Reference to $$VFILE^DILFD,$$VFIELD^DILFD in ICR #2055
  1.  ; Reference to $$GET1^DIQ in ICR #2056
  1.  ;
  1.  Q
  1. LISTER(YSDATA,YS) ;list entries
  1.  ;entry point for YTQ GENERIC LISTER rpc
  1.  ;input: CODE as test name
  1.  ;output: Field^Value
  1.  N YSFIELD,YSFILEN,N,C,YSNUMBER,YSFLAG,YSFROM,YSINDEX,YTTLKUP
  1.  S YTTLKUP=1  ; suppress filter on 601.71
  1.  S YSFILEN=$G(YS("FILEN"),0) S X=$$VFILE^DILFD(YSFILEN) I X=0 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FILE N" Q  ;--->out
  1.  S YSFIELD=$G(YS("FIELD"),0) S X=$$VFIELD^DILFD(YSFILEN,YSFIELD) I X=0 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FIELD N" Q  ;--->out
  1.  S YSFLAG=$G(YS("FLAG"))
  1.  S YSNUMBER=$G(YS("NUMBER"),500)
  1.  S YSFROM("IEN")=$G(YS("FROM"))
  1.  S YSINDEX=$G(YS("INDEX"))
  1.  D LIST^DIC(YSFILEN,,YSFIELD,YSFLAG,YSNUMBER,.YSFROM,,YSINDEX)
  1.  I $D(^TMP("DIERR",$J)) S YSDATA(1)="[ERROR]",YSDATA(2)=$G(^TMP("DIERR",$J,1,"TEXT",1)) Q  ;--> out
  1.  S YSDATA(1)="[DATA]"
  1.  S YSDATA(2)=^TMP("DILIST",$J,0)
  1.  S C=2,N=0
  1.  F  S N=$O(^TMP("DILIST",$J,2,N)) Q:N'>0  D
  1.  . S C=C+1
  1.  . S YSDATA(C)=^TMP("DILIST",$J,2,N)_U_$G(^TMP("DILIST",$J,"ID",N,YSFIELD))
  1.  K ^TMP("DILIST",$J)
  1.  Q
  1. ALLANS(YSDATA,YS) ;get all answers
  1.  ;entry point for YTQ ALL ANSWERS rpc
  1.  ;input:AD = ADMINISTRATION #
  1.  ;output: [DATA]
  1.  ; ADMIN ID^DFN^INSTRUMENT^DATE GIVEN^IS COMPLETE
  1.  ;QUESTION #^seq^ANSWER
  1.  N G,G1,N,YSAD,YSQN,YSTSTN,YSEQ,YSICON
  1.  N IEN71,YSRTN,YSRTN71 ; llh patch 123
  1.  S YSAD=$G(YS("AD"))
  1.  I YSAD'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad ad num" Q  ;-->out
  1.  I '$D(^YTT(601.85,"AC",YSAD)) S YSDATA(1)="[ERROR]",YSDATA(2)="no such reference" Q  ;-->out
  1.  S YSTSTN=$P(^YTT(601.84,YSAD,0),U,3)
  1.  S YSDATA(1)="[DATA]"
  1.  S YSDATA(2)=YSAD_U_$$GET1^DIQ(601.84,YSAD_",",1,"I")_U_$$GET1^DIQ(601.84,YSAD_",",2,"E")_U_$$GET1^DIQ(601.84,YSAD_",",3,"I")_U_$$GET1^DIQ(601.84,YSAD_",",8,"I")
  1.  S YSQN=0,N=2
  1.  F  S YSQN=$O(^YTT(601.85,"AC",YSAD,YSQN)) Q:YSQN'>0  S G=0 D
  1.  .S G=$O(^YTT(601.85,"AC",YSAD,YSQN,G)) Q:G'>0  S G1=0 D
  1.  ..S YSICON=$O(^YTT(601.76,"AF",YSTSTN,YSQN,0))
  1.  ..S YSEQ=1
  1.  ..I YSICON?1N.N S YSEQ=$P(^YTT(601.76,YSICON,0),U,3)
  1.  ..S:$P(^YTT(601.85,G,0),U,4)?1N.N N=N+1,YSDATA(N)=YSQN_U_YSEQ_U_$P(^YTT(601.85,G,0),U,4)
  1.  ..F  S G1=$O(^YTT(601.85,G,1,G1)) Q:G1'>0  S N=N+1,YSDATA(N)=YSQN_U_YSEQ_";"_G1_U_$G(^YTT(601.85,G,1,G1,0))
  1.  I $P(^YTT(601.84,YSAD,0),U,9)'="Y" QUIT  ; chk special proc only if complete
  1.  ;llh patch 123, check for special processing of complex instruments
  1.  S IEN71=$O(^YTT(601.71,"B",$P(YSDATA(2),U,3),0))
  1.  S YSRTN71=$$GET1^DIQ(601.71,IEN71_",",92)
  1.  I (YSRTN71'=""),(YSRTN71'="YTSCORE") D
  1.  .N RPRIV S RPRIV=$P($G(^YTT(601.71,IEN71,2)),U) ; wrap for note
  1.  .S YSRTN="DLLSTR^"_YSRTN71_"(.YSDATA,.YS,2)"
  1.  .I $L($T(@("DLLSTR^"_YSRTN71))) D @YSRTN D:'$L(RPRIV) WRAP(80)
  1.  D SPECIAL^YTQAPI2A(.YSDATA,N,YSAD,YSTSTN)
  1.  Q
  1. SETANS(YSDATA,YS) ;save an answer
  1.  ;entry point for YTQ SET ANSWER rpc
  1.  ;input: AD = ADMINISTRATION #
  1.  ;input: QN= QUESTION #
  1.  ;input: CHOICE= Choice ID [optional]
  1.  ;input: YS(1) thru YS(N) WP entries
  1.  ;output: [DATA] vs [ERROR]
  1.  N N,N1,YSIENS,YSAD,YSQN,YSCI,YSCODE,YSOP
  1.  S YSDATA(1)="[ERROR]"
  1.  S YSAD=$G(YS("AD"))
  1.  S YSQN=$G(YS("QN"))
  1.  S YSCI=$G(YS("CHOICE"))
  1.  I YSAD'?1N.N S YSDATA(2)="bad ad num" Q  ;-->out
  1.  I YSQN'?1N.N S YSDATA(2)="bad quest num" Q  ;-->out
  1.  I $D(^YTT(601.85,"AC",YSAD,YSQN)) S YSIENS=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
  1.  I '$D(^YTT(601.85,"AC",YSAD,YSQN)) D  ; set new entry
  1.  . S YSIENS=""
  1.  . S YSIENS=$$NEW^YTQAPI17(601.85)
  1.  . Q:YSIENS'?1N.N
  1.  . L +^YTT(601.85,YSIENS):DILOCKTM I '$T S YSDATA(2)="time out" Q
  1.  . S ^YTT(601.85,YSIENS,0)=YSIENS_U_YSAD_U_YSQN
  1.  . S ^YTT(601.85,"B",YSIENS,YSIENS)=""
  1.  . S ^YTT(601.85,"AC",YSAD,YSQN,YSIENS)=""
  1.  . S ^YTT(601.85,"AD",YSAD,YSIENS)=""
  1.  . L -^YTT(601.85,YSIENS)
  1.  Q:$D(YSDATA(2))
  1.  ;enter or delete Answers
  1.  S $P(^YTT(601.85,YSIENS,0),U,4)=YSCI
  1.  K ^YTT(601.85,YSIENS,1)
  1.  S N=0,N1=0
  1.  F  S N=$O(YS(N)) Q:N'>0  S N1=N1+1,^YTT(601.85,YSIENS,1,N1,0)=YS(N)
  1.  S:N1 ^YTT(601.85,YSIENS,1,0)=U_U_N1_U_N1_U_DT_U
  1.  S YSDATA(1)="[DATA]",YSDATA(2)="OK"
  1.  D UPANS^YTQEVNT(+$G(YSAD),"saveone") ; publish admin update event
  1.  ;set has been operational
  1.  S YSCODE=$P(^YTT(601.84,YSAD,0),U,3)
  1.  S YSOP=$P($G(^YTT(601.71,YSCODE,2)),U,2)
  1.  S:YSOP="Y" $P(^YTT(601.71,YSCODE,2),U,5)="Y"
  1.  Q
  1. ADMINS(YSDATA,YS) ;administration retrieval
  1.  ;entry point for YTQ GET ADMINISTRATIONS rpc
  1.  ;input : DFN
  1.  ;output:AdministrationID=InstrumentName^DateGiven^DateSaved^OrderedBy^AdministeredBy^Signed^IsComplete^NumberOfQuestionsAnswered
  1.  N N,G,DFN,YSIENS
  1.  S DFN=$G(YS("DFN"))
  1.  I DFN'?1N.NP S YSDATA(1)="[ERROR]",YSDATA(2)="bad DFN" Q  ;-->out asf 2/22/08
  1.  I '$D(^DPT(DFN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="no pt" Q  ;-->out
  1.  S YSIENS=0,N=2
  1.  S YSDATA(1)="[DATA]"
  1.  F  S YSIENS=$O(^YTT(601.84,"C",DFN,YSIENS)) Q:YSIENS'>0  D
  1.  . S N=N+1
  1.  . S G=$G(^YTT(601.84,YSIENS,0))
  1.  . I G="" S YSDATA(1)="[ERROR]",YSDATA(2)=YSIENS_" bad ien in 84" Q  ;-->out
  1.  . S YSDATA(N)=YSIENS_"="_$$GET1^DIQ(601.84,YSIENS_",",2)_U_$P(G,U,4)_U_$P(G,U,5)
  1.  . S YSDATA(N)=YSDATA(N)_U_$$GET1^DIQ(601.84,YSIENS_",",5,"I")_U_$$GET1^DIQ(601.84,YSIENS_",",6,"I")
  1.  . S YSDATA(N)=YSDATA(N)_U_$$GET1^DIQ(601.84,YSIENS_",",7)_U_$$GET1^DIQ(601.84,YSIENS_",",8)_U_$$GET1^DIQ(601.84,YSIENS_",",9)
  1.  S:YSDATA(1)="[DATA]" YSDATA(2)=(N-2)_" administrations"
  1.  Q
  1. CCALL(YSDATA) ;all choices returned
  1.  ;entry point for YTQ ALL CHOICES rpc
  1.  ;output: 601.75(1) CHOICETYPE ID^SEQUENCE^CHOICE IFN^CHOICE TEXT
  1.  N N,YSCDA,YSN,YSN1
  1.  S YSN=0,N=1
  1.  S YSDATA(1)="[DATA]"
  1.  F  S YSN=$O(^YTT(601.751,YSN)) Q:YSN'>0  D
  1.  . S YSN1=0 F  S YSN1=$O(^YTT(601.751,"AC",YSN,YSN1)) Q:YSN1'>0  D
  1.  .. S YSCDA=0 F  S YSCDA=$O(^YTT(601.751,"AC",YSN,YSN1,YSCDA)) Q:YSCDA'>0  D
  1.  ... S N=N+1
  1.  ... S YSDATA(N)=YSN_U_YSN1_U_YSCDA_U_$G(^YTT(601.75,YSCDA,1))
  1.  Q
  1. WRAP(MAX) ; Make sure DLLStr is wrapped by adding | chars
  1.  ; expects YSDATA
  1.  N LN,TX,OUT,I,J,X,Y,YNEW
  1.  S LN=$O(YSDATA(9999999999),-1)
  1.  S TX=$P(YSDATA(LN),U,3,99)
  1.  F I=1:1:$L(TX,"|") S X=$P(TX,"|",I) D
  1.  . I $L(X)'>MAX D ADDOUT(X) QUIT
  1.  . S Y=""
  1.  . F J=1:1:$L(X," ") D
  1.  . . S YNEW=Y_$S(J=1:"",1:" ")_$P(X," ",J)
  1.  . . I $L(YNEW)>MAX D ADDOUT(Y) S Y=$P(X," ",J) I 1
  1.  . . E  S Y=YNEW
  1.  . D ADDOUT(Y) ; add any remaining
  1.  S X="",I=0 F  S I=$O(OUT(I)) Q:'I  S X=X_$S(I=1:"",1:"|")_OUT(I)
  1.  S $P(YSDATA(LN),U,3)=X
  1.  Q
  1. ADDOUT(S) ; add string to out array (expects OUT)
  1.  S OUT=+$G(OUT)+1,OUT(OUT)=S
  1.  Q