YTQAPI17 ;ALB/ASF - MHA REMOTE PROCEDURES IMPORT ;3/18/10 3:16pm
;;5.01;MENTAL HEALTH;**96,217,235,233**;Dec 30, 1994;Build 13
;
;No external references in this routine
;
Q
SAVEALL(YSDATA,YS) ;save all answers from an administration
;input: AD = ADMINISTRATION #
;output: [DATA] vs [ERROR]
N G,G1,N,N1,YSIENS,YSAD,YSQN,YSCI,YSCODE,YSOP,YSFLAG
S YSDATA(1)="[ERROR]"
S YSAD=$G(YS("AD"))
I YSAD'?1N.N S YSDATA(2)="bad ad num" Q ;-->out
I '$D(^YTT(601.84,YSAD)) S YSDATA(2)="NO Admin set" Q ;-->out
;loop thru YS
S YSFLAG=0,N=0 F S N=$O(YS(N)) Q:(N'>0)!(YSFLAG) D
. S YSQN=$P(YS(N),U),YSCI=$P(YS(N),U,2)
. ;use old ien
. I $D(^YTT(601.85,"AC",YSAD,YSQN)) S YSIENS=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
. ;set new ien
. I '$D(^YTT(601.85,"AC",YSAD,YSQN)) S YSIENS="",YSIENS=$$NEW(601.85)
. I YSIENS'?1N.N S YSFLAG=1,YSDATA(1)="[ERROR]",YSDATA(2)="bad ans ien" Q ;-->out
. L +^YTT(601.85,YSIENS):DILOCKTM
. I '$T S YSFLAG=1,YSDATA(1)="[ERROR]",YSDATA(2)="time out" Q ;-->out
. S ^YTT(601.85,YSIENS,0)=YSIENS_U_YSAD_U_YSQN_U_YSCI
. S ^YTT(601.85,"B",YSIENS,YSIENS)=""
. S ^YTT(601.85,"AC",YSAD,YSQN,YSIENS)=""
. S ^YTT(601.85,"AD",YSAD,YSIENS)=""
. K ^YTT(601.85,YSIENS,1) ; reset ANSWERS wp field since saving over it
. S N1=0 F S N1=$O(YS(N,N1)) Q:N1'>0 S ^YTT(601.85,YSIENS,1,N1,0)=YS(N,N1),^YTT(601.85,YSIENS,1,0)=U_U_N1_U_N1_U_DT_U
. L -^YTT(601.85,YSIENS)
. S YSDATA(2)=N_"^OK"
;set has been operational
S YSDATA(1)="[DATA]"
S YSCODE=$P(^YTT(601.84,YSAD,0),U,3)
S YSOP=$P($G(^YTT(601.71,YSCODE,2)),U,2)
S:YSOP="Y" $P(^YTT(601.71,YSCODE,2),U,5)="Y"
Q
NEW(YSFILEN) ; Adding New Entry -- return IEN -- use incremental locking
N MHQ2X,MHQ2XFND,YS
S YS=$P($G(^YTT(YSFILEN,0)),U,3) S:YS<1 YS=1
I '$D(^XUSEC("YSPROG",DUZ)),(YS<100000) S YS=100000 ; Natl pointers <100000
S MHQ2XFND=0
L +^YTT(YSFILEN,0):DILOCKTM Q:'$T ""
F MHQ2X=YS:1 I '$D(^YTT(YSFILEN,MHQ2X)) D Q:MHQ2XFND
. S ^YTT(YSFILEN,MHQ2X,0)=MHQ2X,MHQ2XFND=1
. S $P(^YTT(YSFILEN,0),U,3)=MHQ2X
. S $P(^YTT(YSFILEN,0),U,4)=$P($G(^YTT(YSFILEN,0)),U,4)+1
L -^YTT(YSFILEN,0)
Q MHQ2X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQAPI17 2135 printed Apr 09, 2024@21:19:46 Page 2
YTQAPI17 ;ALB/ASF - MHA REMOTE PROCEDURES IMPORT ;3/18/10 3:16pm
+1 ;;5.01;MENTAL HEALTH;**96,217,235,233**;Dec 30, 1994;Build 13
+2 ;
+3 ;No external references in this routine
+4 ;
+5 QUIT
SAVEALL(YSDATA,YS) ;save all answers from an administration
+1 ;input: AD = ADMINISTRATION #
+2 ;output: [DATA] vs [ERROR]
+3 NEW G,G1,N,N1,YSIENS,YSAD,YSQN,YSCI,YSCODE,YSOP,YSFLAG
+4 SET YSDATA(1)="[ERROR]"
+5 SET YSAD=$GET(YS("AD"))
+6 ;-->out
IF YSAD'?1N.N
SET YSDATA(2)="bad ad num"
QUIT
+7 ;-->out
IF '$DATA(^YTT(601.84,YSAD))
SET YSDATA(2)="NO Admin set"
QUIT
+8 ;loop thru YS
+9 SET YSFLAG=0
SET N=0
FOR
SET N=$ORDER(YS(N))
if (N'>0)!(YSFLAG)
QUIT
Begin DoDot:1
+10 SET YSQN=$PIECE(YS(N),U)
SET YSCI=$PIECE(YS(N),U,2)
+11 ;use old ien
+12 IF $DATA(^YTT(601.85,"AC",YSAD,YSQN))
SET YSIENS=$ORDER(^YTT(601.85,"AC",YSAD,YSQN,0))
+13 ;set new ien
+14 IF '$DATA(^YTT(601.85,"AC",YSAD,YSQN))
SET YSIENS=""
SET YSIENS=$$NEW(601.85)
+15 ;-->out
IF YSIENS'?1N.N
SET YSFLAG=1
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad ans ien"
QUIT
+16 LOCK +^YTT(601.85,YSIENS):DILOCKTM
+17 ;-->out
IF '$TEST
SET YSFLAG=1
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="time out"
QUIT
+18 SET ^YTT(601.85,YSIENS,0)=YSIENS_U_YSAD_U_YSQN_U_YSCI
+19 SET ^YTT(601.85,"B",YSIENS,YSIENS)=""
+20 SET ^YTT(601.85,"AC",YSAD,YSQN,YSIENS)=""
+21 SET ^YTT(601.85,"AD",YSAD,YSIENS)=""
+22 ; reset ANSWERS wp field since saving over it
KILL ^YTT(601.85,YSIENS,1)
+23 SET N1=0
FOR
SET N1=$ORDER(YS(N,N1))
if N1'>0
QUIT
SET ^YTT(601.85,YSIENS,1,N1,0)=YS(N,N1)
SET ^YTT(601.85,YSIENS,1,0)=U_U_N1_U_N1_U_DT_U
+24 LOCK -^YTT(601.85,YSIENS)
+25 SET YSDATA(2)=N_"^OK"
End DoDot:1
+26 ;set has been operational
+27 SET YSDATA(1)="[DATA]"
+28 SET YSCODE=$PIECE(^YTT(601.84,YSAD,0),U,3)
+29 SET YSOP=$PIECE($GET(^YTT(601.71,YSCODE,2)),U,2)
+30 if YSOP="Y"
SET $PIECE(^YTT(601.71,YSCODE,2),U,5)="Y"
+31 QUIT
NEW(YSFILEN) ; Adding New Entry -- return IEN -- use incremental locking
+1 NEW MHQ2X,MHQ2XFND,YS
+2 SET YS=$PIECE($GET(^YTT(YSFILEN,0)),U,3)
if YS<1
SET YS=1
+3 ; Natl pointers <100000
IF '$DATA(^XUSEC("YSPROG",DUZ))
IF (YS<100000)
SET YS=100000
+4 SET MHQ2XFND=0
+5 LOCK +^YTT(YSFILEN,0):DILOCKTM
if '$TEST
QUIT ""
+6 FOR MHQ2X=YS:1
IF '$DATA(^YTT(YSFILEN,MHQ2X))
Begin DoDot:1
+7 SET ^YTT(YSFILEN,MHQ2X,0)=MHQ2X
SET MHQ2XFND=1
+8 SET $PIECE(^YTT(YSFILEN,0),U,3)=MHQ2X
+9 SET $PIECE(^YTT(YSFILEN,0),U,4)=$PIECE($GET(^YTT(YSFILEN,0)),U,4)+1
End DoDot:1
if MHQ2XFND
QUIT
+10 LOCK -^YTT(YSFILEN,0)
+11 QUIT MHQ2X
+12 ;
