- YTQAPI17 ;ALB/ASF - MHA REMOTE PROCEDURES IMPORT ;3/18/10 3:16pm
- ;;5.01;MENTAL HEALTH;**96,217,235,233,240**;Dec 30, 1994;Build 10
- ;
- ;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]"
- D UPANS^YTQEVNT($G(YSAD),"saveall") ; publish admin update event
- 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 2206 printed Feb 18, 2025@23:44:29 Page 2
- YTQAPI17 ;ALB/ASF - MHA REMOTE PROCEDURES IMPORT ;3/18/10 3:16pm
- +1 ;;5.01;MENTAL HEALTH;**96,217,235,233,240**;Dec 30, 1994;Build 10
- +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 ; publish admin update event
- DO UPANS^YTQEVNT($GET(YSAD),"saveall")
- +29 SET YSCODE=$PIECE(^YTT(601.84,YSAD,0),U,3)
- +30 SET YSOP=$PIECE($GET(^YTT(601.71,YSCODE,2)),U,2)
- +31 if YSOP="Y"
- SET $PIECE(^YTT(601.71,YSCODE,2),U,5)="Y"
- +32 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 ;