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

YTQAPI1.m

Go to the documentation of this file.
  1. YTQAPI1 ;ASF/ALB - MHAX REMOTE PROCEDURES ;Oct 31, 2024@14:00:33
  1. ;;5.01;MENTAL HEALTH;**85,119,121,141,217,249,252,240,250**;Dec 30, 1994;Build 26
  1. ;
  1. ;
  1. ;
  1. Q
  1. RULES(YSDATA,YS) ;list rules for a survey
  1. ;entry point for YTQ RULES rpc
  1. ;input: CODE as test name
  1. ;output: Field^Value
  1. N YSBOOL,YSQID,YSRID,YSTESTN,YSTEST,G,G1,G2,N,N1,N2,Z
  1. S YSTEST=$G(YS("CODE"))
  1. I YSTEST="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO code" Q ;-->out
  1. S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
  1. I YSTESTN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q ;-->out
  1. S YSDATA(1)="[DATA]"
  1. S N1=1
  1. I '$D(^YTT(601.83,"C",YSTESTN)) S YSDATA(2)="No Rules" Q ;--> out
  1. S N=0 F S N=$O(^YTT(601.83,"C",YSTESTN,N)) Q:N'>0 D
  1. . S YSRID=$P(^YTT(601.83,N,0),U,4)
  1. . S G=$G(^YTT(601.82,YSRID,0)) Q:G="" ;-->cross bad 83 vs 82
  1. . S G1=$G(^YTT(601.82,YSRID,1)),G2=$G(^YTT(601.82,YSRID,2))
  1. . S YSQID=$P(G,U,2) S:YSQID="" YSQID=0
  1. . S YSBOOL=$P(G,U,6) S:YSBOOL="" YSBOOL=0
  1. . S N1=N1+1
  1. . S Z(YSQID,YSBOOL,N1,1)=$P(G,U)_"="_$P(G,U,2)_U_$P(G,U,4)_U_$P(G,U,5)_U_$P(G,U,3)_U_$P(G,U,6)_U_$P(G,U,7)
  1. . S Z(YSQID,YSBOOL,N1,2)=$P(G1,U,2)_U_$P(G1,U,3)_U_$P(G1,U)
  1. . S Z(YSQID,YSBOOL,N1,3)=$P(G2,U)_U_$S($P(G2,U,2)="Y":"YES",$P(G2,U,2)="N":"NO",1:"")
  1. S N2=1
  1. S YSQID=0 F S YSQID=$O(Z(YSQID)) Q:YSQID'>0 S YSBOOL="Z" F S YSBOOL=$O(Z(YSQID,YSBOOL),-1) Q:YSBOOL="" S N1=0 F S N1=$O(Z(YSQID,YSBOOL,N1)) Q:N1'>0 D
  1. . S N2=N2+1,YSDATA(N2)=Z(YSQID,YSBOOL,N1,1)
  1. . S N2=N2+1,YSDATA(N2)=Z(YSQID,YSBOOL,N1,2)
  1. . S N2=N2+1,YSDATA(N2)=Z(YSQID,YSBOOL,N1,3)
  1. Q
  1. EDAD(YSDATA,YS) ;Edit and Save Data
  1. N YSERR,YSX,YSNN,YSRESULT,G,YSF,YSV,N,YSIEN,YSFILEN,YSERRLOG
  1. N YTTLKUP S YTTLKUP=1 ; don't filter 601.71
  1. S YSERRLOG="EDAD^YTQAPI1 : Error Saving MH Administration"
  1. K ^TMP("YSMHI",$J)
  1. S YSFILEN=$G(YS("FILEN"))
  1. I (YSFILEN<601)!(YSFILEN>605) D QUIT
  1. . D ERR(.YSDATA,"bad filen ",YSERRLOG)
  1. S YSIEN=$G(YS("IEN"),"?+1")_","
  1. I YSFILEN=601.84 S N=$O(YS("FILEN"),-1)+1 S:'$D(YS(N)) YS(N)="18^`"_DUZ
  1. S N=0 F S N=$O(YS(N)) Q:N'>0 D Q:$G(YSRESULT)="^"
  1. . S G=YS(N)
  1. . S YSF=$P(G,U),YSV=$P(G,U,2),YSX=$P(G,U,3)
  1. . I '$$VFIELD^DILFD(YSFILEN,YSF) S YSRESULT=1 Q
  1. . I YSV="" S YSRESULT=1 Q
  1. . S ^TMP("YSMHI",$J,YSFILEN,YSIEN,YSF)=YSV
  1. . D:YSX'=1 VAL^DIE(YSFILEN,YSIEN,+YSF,"E",YSV,.YSRESULT)
  1. . ;
  1. I $G(YSRESULT)="^" D QUIT
  1. . D ERR(.YSDATA,"Value for Field Not Valid^"_YSV_U_YSF,YSERRLOG)
  1. L +^YTT(YSFILEN,0):DILOCKTM
  1. I '$T D QUIT
  1. . D ERR(.YSDATA,"Could not save administration. (Failed to get lock on File #"_YSFILEN_").",YSERRLOG)
  1. D UPDATE^DIE("E","^TMP(""YSMHI"",$J)","YSNN","YSERR")
  1. L -^YTT(YSFILEN,0)
  1. I $D(YSERR) D QUIT
  1. . D ERR(.YSDATA,"Update Error",YSERRLOG)
  1. S YSDATA(1)="[DATA]",YSDATA(2)="Update ok^"_$G(YSNN(1))_U_$G(YSNN(1,0))
  1. ; publish add/edit admin event
  1. I YSFILEN=601.84 D UPADM^YTQEVNT($S(+$G(YSNN(1)):+YSNN(1),1:+$G(YS("IEN"))),"editadd")
  1. ;
  1. Q
  1. WPED(YSDATA,YS) ;Replace WP field
  1. ;entry point for YTQ WP FILER rpc
  1. ;INPUT: filen,ien,field,ys(1)...ys(x)= text
  1. N YSF,N,YSIEN,YSERR,YSFILEN
  1. N YTTLKUP S YTTLKUP=1 ; don't filter 601.71
  1. K ^TMP("YSMHI",$J)
  1. S YSFILEN=$G(YS("FILEN"))
  1. I YSFILEN="" S YSDATA(1)="[ERROR]",YSDATA(2)="bad filen " Q ;-->out
  1. S YSIEN=$G(YS("IEN"))
  1. I YSIEN'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad IEN " Q ;-->out
  1. S YSIEN=YSIEN_","
  1. S YSF=$G(YS("FIELD")) S X=$$VFIELD^DILFD(YSFILEN,YSF) I X=0 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD FIELD #" Q ;-->out
  1. S N=0 F S N=$O(YS(N)) Q:N'>0 D
  1. . S ^TMP("YSMHI",$J,N)=$G(YS(N))
  1. D WP^DIE(YSFILEN,YSIEN,YSF,,"^TMP(""YSMHI"",$J)","YSERR")
  1. I $D(YSERR) S YSDATA(1)="[ERROR]",YSDATA(2)="very BAD Update Error" Q ;-->out
  1. S YSDATA(1)="[DATA]",YSDATA(2)="ZZUpdate ok WP "_YSIEN
  1. Q
  1. GETANS(YSDATA,YS) ;get an answer
  1. ;entry point for YTQ GETANS rpc
  1. ;AD = ADMINISTRATION #
  1. ;QN= QUESTION #
  1. N G,G1,N,YSAD,YSQN
  1. S YSAD=$G(YS("AD"))
  1. S YSQN=$G(YS("QN"))
  1. I YSAD'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad ad num" Q ;-->out
  1. I YSQN'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad quest num" Q ;-->out
  1. I '$D(^YTT(601.85,"AC",YSAD,YSQN)) S YSDATA(1)="[ERROR]",YSDATA(2)="no such reference" Q ;-->out
  1. S YSDATA(1)="[DATA]"
  1. S G=0,N=1
  1. S G=$O(^YTT(601.85,"AC",YSAD,YSQN,G)) Q:G'>0 S G1=0 D
  1. . S:$P(^YTT(601.85,G,0),U,4)?1N.N N=N+1,YSDATA(N)=$P(^YTT(601.85,G,0),U,4) ;ASF 3/10/04 ***
  1. . F S G1=$O(^YTT(601.85,G,1,G1)) Q:G1'>0 S N=N+1,YSDATA(N)=$G(^YTT(601.85,G,1,G1,0))
  1. Q
  1. CAPIE(YSDATA,YS) ;entry point for YTQ CAPIE rpc
  1. N N,N1,N2,YSFIELDS,YSFILEN,YSIENS,X
  1. K ^TMP("YS",$J)
  1. K ^TMP("YSDATA",$J) S YSDATA=$NA(^TMP("YSDATA",$J))
  1. S ^TMP("YSDATA",$J,1)="[ERROR]"
  1. S YSFILEN=$G(YS("FILEN"),0) I $$VFILE^DILFD(YSFILEN)<1 S ^TMP("YSDATA",$J,2)="BAD FILE N" Q ;--->out
  1. S YSFIELDS=$G(YS("FIELDS"),"")
  1. S:YSFIELDS="*" YSFIELDS="**"
  1. I YSFIELDS="**"&(YSFILEN=604) S YSFIELDS=".03:200"
  1. I YSFIELDS?1N.N S N=$$VFIELD^DILFD(YSFILEN,YSFIELDS) I N<1 S ^TMP("YSDATA",$J,2)="BAD field" Q ;--> out
  1. S YSIENS=$G(YS("IENS")) I YSIENS'?1N.N S ^TMP("YSDATA",$J,2)="BAD IENS" Q ;-->out
  1. S YSIENS=YSIENS_","
  1. D GETS^DIQ(YSFILEN,YSIENS,YSFIELDS,"IE","^TMP(""YS"",$J")
  1. S N=1,^TMP("YSDATA",$J,1)="[DATA]"
  1. S N1=0 F S N1=$O(^TMP("YS",$J,YSFILEN,YSIENS,N1)) Q:N1'>0 D
  1. . S N2=0 F S N2=$O(^TMP("YS",$J,YSFILEN,YSIENS,N1,N2)) Q:N2'>0 S N=N+1,^TMP("YSDATA",$J,N)=N1_";"_N2_U_$$GET1^DID(YSFILEN,N1,"","LABEL")_U_^TMP("YS",$J,YSFILEN,YSIENS,N1,N2)
  1. . I ^TMP("YS",$J,YSFILEN,YSIENS,N1,"I")'?1"^TMP(".E S N=N+1,^TMP("YSDATA",$J,N)=N1_U_$$GET1^DID(YSFILEN,N1,"","LABEL")_U_$G(^TMP("YS",$J,YSFILEN,YSIENS,N1,"I"))
  1. . S:(^TMP("YS",$J,YSFILEN,YSIENS,N1,"E")'=^TMP("YS",$J,YSFILEN,YSIENS,N1,"I")) ^TMP("YSDATA",$J,N)=^TMP("YSDATA",$J,N)_U_^TMP("YS",$J,YSFILEN,YSIENS,N1,"E")
  1. K ^TMP("YS",$J)
  1. Q
  1. ADMSAVE(YSDATA,YS) ; create new entry in MH ADMINISTRATIONS (601.84)
  1. ; ensure the YTQ ADMIN SAVE rpc can only modify 601.84
  1. S YS("FILEN")=601.84
  1. N I S I=0
  1. F S I=$O(YS(I)) Q:'I I $P(YS(I),U)="15" S YS(I)="15^`"_$$SRC($P(YS(I),U,2))
  1. D EDAD(.YSDATA,.YS)
  1. Q
  1. SRC(ANAME) ; return IEN for entry source, adding if needed
  1. N IEN
  1. S IEN=$O(^YTT(601.844,"C",$$UP^XLFSTR(ANAME),0))
  1. I IEN QUIT IEN
  1. ;
  1. N YTFDA,YTIEN,YTERR,DIERR
  1. S YTFDA(601.844,"+1,",.01)=ANAME
  1. D UPDATE^DIE("E","YTFDA","YTIEN","YTERR")
  1. S IEN="" I '$D(DIERR),YTIEN(1) S IEN=YTIEN(1)
  1. D CLEAN^DILF
  1. Q IEN
  1. ;
  1. ERR(YSDATA,YSRETMSG,YSLOGMSG) ; Set return error array (YSDATA); and log error to VistA error trap
  1. N %ZT
  1. S YSDATA(1)="[ERROR]"
  1. S YSDATA(2)=YSRETMSG
  1. I +$$GET^XPAR("ALL","YS MHA LOG APPLICATION ERRORS",1,"I") D APPERROR^%ZTER(YSLOGMSG)
  1. Q
  1. ;