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

YTQAPI17.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;No external references in this routine
  1. ;
  1. Q
  1. SAVEALL(YSDATA,YS) ;save all answers from an administration
  1. ;input: AD = ADMINISTRATION #
  1. ;output: [DATA] vs [ERROR]
  1. N G,G1,N,N1,YSIENS,YSAD,YSQN,YSCI,YSCODE,YSOP,YSFLAG
  1. S YSDATA(1)="[ERROR]"
  1. S YSAD=$G(YS("AD"))
  1. I YSAD'?1N.N S YSDATA(2)="bad ad num" Q ;-->out
  1. I '$D(^YTT(601.84,YSAD)) S YSDATA(2)="NO Admin set" Q ;-->out
  1. ;loop thru YS
  1. S YSFLAG=0,N=0 F S N=$O(YS(N)) Q:(N'>0)!(YSFLAG) D
  1. . S YSQN=$P(YS(N),U),YSCI=$P(YS(N),U,2)
  1. . ;use old ien
  1. . I $D(^YTT(601.85,"AC",YSAD,YSQN)) S YSIENS=$O(^YTT(601.85,"AC",YSAD,YSQN,0))
  1. . ;set new ien
  1. . I '$D(^YTT(601.85,"AC",YSAD,YSQN)) S YSIENS="",YSIENS=$$NEW(601.85)
  1. . I YSIENS'?1N.N S YSFLAG=1,YSDATA(1)="[ERROR]",YSDATA(2)="bad ans ien" Q ;-->out
  1. . L +^YTT(601.85,YSIENS):DILOCKTM
  1. . I '$T S YSFLAG=1,YSDATA(1)="[ERROR]",YSDATA(2)="time out" Q ;-->out
  1. . S ^YTT(601.85,YSIENS,0)=YSIENS_U_YSAD_U_YSQN_U_YSCI
  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. . K ^YTT(601.85,YSIENS,1) ; reset ANSWERS wp field since saving over it
  1. . 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
  1. . L -^YTT(601.85,YSIENS)
  1. . S YSDATA(2)=N_"^OK"
  1. ;set has been operational
  1. S YSDATA(1)="[DATA]"
  1. D UPANS^YTQEVNT($G(YSAD),"saveall") ; publish admin update event
  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. NEW(YSFILEN) ; Adding New Entry -- return IEN -- use incremental locking
  1. N MHQ2X,MHQ2XFND,YS
  1. S YS=$P($G(^YTT(YSFILEN,0)),U,3) S:YS<1 YS=1
  1. I '$D(^XUSEC("YSPROG",DUZ)),(YS<100000) S YS=100000 ; Natl pointers <100000
  1. S MHQ2XFND=0
  1. L +^YTT(YSFILEN,0):DILOCKTM Q:'$T ""
  1. F MHQ2X=YS:1 I '$D(^YTT(YSFILEN,MHQ2X)) D Q:MHQ2XFND
  1. . S ^YTT(YSFILEN,MHQ2X,0)=MHQ2X,MHQ2XFND=1
  1. . S $P(^YTT(YSFILEN,0),U,3)=MHQ2X
  1. . S $P(^YTT(YSFILEN,0),U,4)=$P($G(^YTT(YSFILEN,0)),U,4)+1
  1. L -^YTT(YSFILEN,0)
  1. Q MHQ2X
  1. ;