AMQQSQ ; IHS/CMI/THL - SUBQUERY MANAGER ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
; WHEN YOU CALL THIS ROUTINE, YOU MUST HAVE THE FOLLOWING VARIABLES:
; AMQQSQAN (SQ SUBJECT)
; AMQQUSQL (LEVEL)
; AMQQSQAA (PARENT SQ OR AMQQUATN)
; AMQQSQSN (SUBJECT NUMBER)
; AMQQSQST (SUBJECT TYPE)
; AMQQUSQN HOLDS THE ABSOLUTE SUBQUERY NUMBER
; AMQQSQNN HOLDS THE CURRENT AMQQUSQN AT THAT LEVEL
; AMQQUQQN HOLDS THE 'QQ' NUMBER
RUN D VAR
I $P(^AMQQ(1,AMQQLINK,0),U,5)'=20 W:'$D(AMQQXX) !!,$S(AMQQCCLS="V":"Note: This visit may have ",1:"SUBQUERY: Analysis of "),"multiple ",AMQQSQSZ,"S",!
E D ^AMQQSQIM I $D(AMQQQUIT) G EXIT
D GET
EXIT K %,AMQQAFN,AMQQNMAS
NOTSTD D SQKILL^AMQQKILL
Q
;
VAR S (AMQQQ,AMQQMULT)=""
I AMQQSQST'="L",AMQQSQST'="I",AMQQSQST'="G" S AMQQCOMP=";;"
S (AMQQSQFN,AMQQSQFR)=0
I $D(AMQQYYMI) Q
S AMQQNAR=$S($D(AMQQONE):AMQQONE,1:"ea. patient")
S %=AMQQSQAN
S %=$P(%,",")
S %=$P(%," (")
S %=$P(%,"(")
S AMQQSQSJ=%
S AMQQSQSZ=$S($E(%,$L(%))="Y":($E(%,1,$L(%)-1)_"IE"),%="DIAGNOSIS":"DIAGNOSE",%="PROBLEM LIST DIAGNOSIS":"PROBLEM LIST DIAGNOSE",%="HEALTH FACTORS":"HEALTH FACTOR",$E(%,$L(%))="S":(%_"E"),1:%)
Q
;
GET S AMQQSQFN=AMQQSQFN+1
I AMQQSQFN=1 S %=+$G(^AMQQ(5,AMQQSQSN,5)) I %,$P(^(5),U,4) K AMQQSQUF D ^AMQQSQUP G:$D(AMQQSQUF) G1 D CANCEL Q
D ^AMQQSQA
I $D(AMQQSQNV) K AMQQSQNV S AMQQSQFN=AMQQSQFN-1 G GET
I $D(AMQQSQQT) K AMQQSQQT D:AMQQUSQL=1 SQR Q
I $D(AMQQQUIT),AMQQSQFN>1 K AMQQQUIT D CANCEL Q
I $D(AMQQQUIT) Q
G1 K AMQQSQUF
D ^AMQQSQS
I $D(AMQQSQSQ) D RECURSE
I $D(AMQQSQQF) D QQ
I $D(AMQQSQNF) Q
I $D(AMQQSQCF) S AMQQNMAS=""
I '$D(AMQQXX),AMQQSQFN>1 W !! F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"SQL",AMQQSQNN,%)) Q:'% W ! X ^(%)
G GET
;
CANCEL W !!,$S(AMQQUSQL=1:"ATTRIBUTE ",1:"SUBQUERY "),"CANCELLED!!!",!!,*7
S AMQQSQJ1="CLEANUP^AMQQSQ"
D TREE2^AMQQSQT
S AMQQCOMP=""
I AMQQUSQL=1 K ^UTILITY("AMQQ",$J,"Q",AMQQUATN) S AMQQUATN=AMQQUATN-1,AMQQXSQF=""
Q
;
CLEANUP K ^UTILITY("AMQQ",$J,$S(AMQQTLVL=1:"SQXQ",1:"SQXS"),AMQQSQN1,AMQQSQN2)
N %
F %="SQ","SQL" K ^UTILITY("AMQQ",$J,%,AMQQSQN2)
Q
;
SQR S AMQQSQFR=0
I AMQQSQFN=1 Q
CHECK I '$G(AMQQSQNN) S %=$G(AMQQCOMP) I '+%,$P(%,";",4)="" S AMQQSQFR=1 Q
I $D(^UTILITY("AMQQ",$J,"SQ",AMQQSQNN,"NULL")) S AMQQSQFR=6 Q
F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"SQ",AMQQSQNN,%)) Q:'% I $P(^(%),U,6)="C" S AMQQSQFR=5 G CEXIT
F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"SQ",AMQQSQNN,%)) Q:'% I $P(^(%),U,6,7)="O^1" S AMQQSQFR=2 G CEXIT
F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"SQ",AMQQSQNN,%)) Q:'% S Y=$P(^(%),U,6) I "TPN"'[Y S AMQQSQFR=$S(Y="O":3,1:0)
CEXIT K AMQQNVAR,AMQQMULR
Q
;
QQ S AMQQUQQN=AMQQUQQN+1
I $G(AMQQSQQF) S ^UTILITY("AMQQ",$J,"SQXX",AMQQUQQN,AMQQSQQF)=""
S ^UTILITY("AMQQ",$J,"SQ",AMQQSQNN,AMQQSQFN)="0^LINK^22^SUB^AMQQF1^"_$E(AMQQSQCT)_"^"_AMQQUQQN_U
S AMQQSQQF=AMQQUQQN
D ^AMQQATS
K AMQQSQQF
Q
;
RECURSE S AMQQUSQL=AMQQUSQL+1
S %=$P(^AMQQ(5,AMQQSQN,0),U,5)
S:%=9 %=AMQQSQN+($J/100000)
S %=$P(^AMQQ(1,%,0),U,5)
S %=$P(^AMQQ(4,%,0),U)
S AMQQTSTG=AMQQSQNM_U_AMQQSQN_U_%_U_AMQQSQNN_U_AMQQSQSQ
N AMQQCOMP,AMQQRECV,AMQQLINK K AMQQSQSQ
FRESH N AMQQSQAA,AMQQSQAN,AMQQSQBF,AMQQSQBS,AMQQSQCF,AMQQSQCT,AMQQSQCV,AMQQSQDF,AMQQSQDV,AMQQSQF1,AMQQSQF2,AMQQSQFL,AMQQSQFL,AMQQSQFN,AMQQSQFR,AMQQSQGF
N AMQQSQJ1,AMQQSQJ2,AMQQSQLS,AMQQSQN,AMQQSQN1,AMQQSQN2,AMQQSQNC,AMQQSQNF,AMQQSQNM,AMQQSQNN,AMQQSQAT,AMQQSQP,AMQQSQP1,AMQQSQP2,AMQQSQPH,AMQQSQPL,AMQQSQPQ,AMQQSQPS,AMQQSQPY,AMQQSQQQ,AMQQSQQT
N AMQQSQRC,AMQQSQRD,AMQQSQSC,AMQQSQSJ,AMQQSQSN,AMQQSQSQ,AMQQSQST,AMQQSQSZ,AMQQSQTF,AMQQSQTP,AMQQSQVV,AMQQSQZL,AMQQSQP,AMQQSQZF ; &&& AMQQSQZF ADDED
S %=AMQQTSTG
S AMQQSQAN=$P(%,U)
S AMQQSQSN=$P(%,U,2)
S AMQQSQST=$P(%,U,3)
S AMQQRECV=$P(%,U,5,99)
S AMQQLINK=$P(AMQQRECV,U,8)
S AMQQSQAA=$P(%,U,4)
S AMQQSQNN=AMQQUSQN
S AMQQSQRC=""
K AMQQTSTG
I $D(AMQQXXND),$D(AMQQYYMI) D AUTO Q
D ^AMQQSQ
R1 I $D(AMQQQUIT) Q
D SETSUB
S AMQQUSQL=AMQQUSQL-1
S AMQQSQQF=AMQQSQRC
K AMQQSQRC
Q
;
SETSUB F %=1,2 S $P(AMQQCOMP,";",%)=$P(AMQQRECV,U,%)
S $P(AMQQCOMP,";",4)=$P(AMQQRECV,U,11)
S AMQQQ=$P(AMQQRECV,U,8,10)_"^1^^^^^"_AMQQCOMP_"^^^^^^"
S $P(AMQQQ,U,17)=$P(AMQQRECV,U,11)
Q
;
EN1 ; ENTRY POINT FROM AMQQQ2
D VAR,GET,EXIT
Q
;
AUTO N AMQQYYYY
S AMQQYYYY=AMQQMMMM
S %=AMQQXXND
N AMQQXXND
S AMQQXXND=$E(%,1,$L(%)-1)_","_AMQQYYMI_",1)"
N AMQQMMMM,AMQQMMCC,AMQQMMVV,AMQQYYMI
S AMQQYYMI=0
D MULT^AMQQQ2
D R1
Q
;
AMQQSQ ; IHS/CMI/THL - SUBQUERY MANAGER ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
+3 ; WHEN YOU CALL THIS ROUTINE, YOU MUST HAVE THE FOLLOWING VARIABLES:
+4 ; AMQQSQAN (SQ SUBJECT)
+5 ; AMQQUSQL (LEVEL)
+6 ; AMQQSQAA (PARENT SQ OR AMQQUATN)
+7 ; AMQQSQSN (SUBJECT NUMBER)
+8 ; AMQQSQST (SUBJECT TYPE)
+9 ; AMQQUSQN HOLDS THE ABSOLUTE SUBQUERY NUMBER
+10 ; AMQQSQNN HOLDS THE CURRENT AMQQUSQN AT THAT LEVEL
+11 ; AMQQUQQN HOLDS THE 'QQ' NUMBER
RUN DO VAR
+1 IF $PIECE(^AMQQ(1,AMQQLINK,0),U,5)'=20
IF '$DATA(AMQQXX)
WRITE !!,$SELECT(AMQQCCLS="V":"Note: This visit may have ",1:"SUBQUERY: Analysis of "),"multiple ",AMQQSQSZ,"S",!
+2 IF '$TEST
DO ^AMQQSQIM
IF $DATA(AMQQQUIT)
GOTO EXIT
+3 DO GET
EXIT KILL %,AMQQAFN,AMQQNMAS
NOTSTD DO SQKILL^AMQQKILL
+1 QUIT
+2 ;
VAR SET (AMQQQ,AMQQMULT)=""
+1 IF AMQQSQST'="L"
IF AMQQSQST'="I"
IF AMQQSQST'="G"
SET AMQQCOMP=";;"
+2 SET (AMQQSQFN,AMQQSQFR)=0
+3 IF $DATA(AMQQYYMI)
QUIT
+4 SET AMQQNAR=$SELECT($DATA(AMQQONE):AMQQONE,1:"ea. patient")
+5 SET %=AMQQSQAN
+6 SET %=$PIECE(%,",")
+7 SET %=$PIECE(%," (")
+8 SET %=$PIECE(%,"(")
+9 SET AMQQSQSJ=%
+10 SET AMQQSQSZ=$SELECT($EXTRACT(%,$LENGTH(%))="Y":($EXTRACT(%,1,$LENGTH(%)-1)_"IE"),%="DIAGNOSIS":"DIAGNOSE",%="PROBLEM LIST DIAGNOSIS":"PROBLEM LIST DIAGNOSE",%="HEALTH FACTORS":"HEALTH FACTOR",$EXTRACT(%,$LENGTH(%))="S":(%_"E"),1:%)
+11 QUIT
+12 ;
GET SET AMQQSQFN=AMQQSQFN+1
+1 IF AMQQSQFN=1
SET %=+$GET(^AMQQ(5,AMQQSQSN,5))
IF %
IF $PIECE(^(5),U,4)
KILL AMQQSQUF
DO ^AMQQSQUP
IF $DATA(AMQQSQUF)
GOTO G1
DO CANCEL
QUIT
+2 DO ^AMQQSQA
+3 IF $DATA(AMQQSQNV)
KILL AMQQSQNV
SET AMQQSQFN=AMQQSQFN-1
GOTO GET
+4 IF $DATA(AMQQSQQT)
KILL AMQQSQQT
IF AMQQUSQL=1
DO SQR
QUIT
+5 IF $DATA(AMQQQUIT)
IF AMQQSQFN>1
KILL AMQQQUIT
DO CANCEL
QUIT
+6 IF $DATA(AMQQQUIT)
QUIT
G1 KILL AMQQSQUF
+1 DO ^AMQQSQS
+2 IF $DATA(AMQQSQSQ)
DO RECURSE
+3 IF $DATA(AMQQSQQF)
DO QQ
+4 IF $DATA(AMQQSQNF)
QUIT
+5 IF $DATA(AMQQSQCF)
SET AMQQNMAS=""
+6 IF '$DATA(AMQQXX)
IF AMQQSQFN>1
WRITE !!
FOR %=0:0
SET %=$ORDER(^UTILITY("AMQQ",$JOB,"SQL",AMQQSQNN,%))
IF '%
QUIT
WRITE !
XECUTE ^(%)
+7 GOTO GET
+8 ;
CANCEL WRITE !!,$SELECT(AMQQUSQL=1:"ATTRIBUTE ",1:"SUBQUERY "),"CANCELLED!!!",!!,*7
+1 SET AMQQSQJ1="CLEANUP^AMQQSQ"
+2 DO TREE2^AMQQSQT
+3 SET AMQQCOMP=""
+4 IF AMQQUSQL=1
KILL ^UTILITY("AMQQ",$JOB,"Q",AMQQUATN)
SET AMQQUATN=AMQQUATN-1
SET AMQQXSQF=""
+5 QUIT
+6 ;
CLEANUP KILL ^UTILITY("AMQQ",$JOB,$SELECT(AMQQTLVL=1:"SQXQ",1:"SQXS"),AMQQSQN1,AMQQSQN2)
+1 NEW %
+2 FOR %="SQ","SQL"
KILL ^UTILITY("AMQQ",$JOB,%,AMQQSQN2)
+3 QUIT
+4 ;
SQR SET AMQQSQFR=0
+1 IF AMQQSQFN=1
QUIT
CHECK IF '$GET(AMQQSQNN)
SET %=$GET(AMQQCOMP)
IF '+%
IF $PIECE(%,";",4)=""
SET AMQQSQFR=1
QUIT
+1 IF $DATA(^UTILITY("AMQQ",$JOB,"SQ",AMQQSQNN,"NULL"))
SET AMQQSQFR=6
QUIT
+2 FOR %=0:0
SET %=$ORDER(^UTILITY("AMQQ",$JOB,"SQ",AMQQSQNN,%))
IF '%
QUIT
IF $PIECE(^(%),U,6)="C"
SET AMQQSQFR=5
GOTO CEXIT
+3 FOR %=0:0
SET %=$ORDER(^UTILITY("AMQQ",$JOB,"SQ",AMQQSQNN,%))
IF '%
QUIT
IF $PIECE(^(%),U,6,7)="O^1"
SET AMQQSQFR=2
GOTO CEXIT
+4 FOR %=0:0
SET %=$ORDER(^UTILITY("AMQQ",$JOB,"SQ",AMQQSQNN,%))
IF '%
QUIT
SET Y=$PIECE(^(%),U,6)
IF "TPN"'[Y
SET AMQQSQFR=$SELECT(Y="O":3,1:0)
CEXIT KILL AMQQNVAR,AMQQMULR
+1 QUIT
+2 ;
QQ SET AMQQUQQN=AMQQUQQN+1
+1 IF $GET(AMQQSQQF)
SET ^UTILITY("AMQQ",$JOB,"SQXX",AMQQUQQN,AMQQSQQF)=""
+2 SET ^UTILITY("AMQQ",$JOB,"SQ",AMQQSQNN,AMQQSQFN)="0^LINK^22^SUB^AMQQF1^"_$EXTRACT(AMQQSQCT)_"^"_AMQQUQQN_U
+3 SET AMQQSQQF=AMQQUQQN
+4 DO ^AMQQATS
+5 KILL AMQQSQQF
+6 QUIT
+7 ;
RECURSE SET AMQQUSQL=AMQQUSQL+1
+1 SET %=$PIECE(^AMQQ(5,AMQQSQN,0),U,5)
+2 IF %=9
SET %=AMQQSQN+($JOB/100000)
+3 SET %=$PIECE(^AMQQ(1,%,0),U,5)
+4 SET %=$PIECE(^AMQQ(4,%,0),U)
+5 SET AMQQTSTG=AMQQSQNM_U_AMQQSQN_U_%_U_AMQQSQNN_U_AMQQSQSQ
+6 NEW AMQQCOMP,AMQQRECV,AMQQLINK
KILL AMQQSQSQ
FRESH NEW AMQQSQAA,AMQQSQAN,AMQQSQBF,AMQQSQBS,AMQQSQCF,AMQQSQCT,AMQQSQCV,AMQQSQDF,AMQQSQDV,AMQQSQF1,AMQQSQF2,AMQQSQFL,AMQQSQFL,AMQQSQFN,AMQQSQFR,AMQQSQGF
+1 NEW AMQQSQJ1,AMQQSQJ2,AMQQSQLS,AMQQSQN,AMQQSQN1,AMQQSQN2,AMQQSQNC,AMQQSQNF,AMQQSQNM,AMQQSQNN,AMQQSQAT,AMQQSQP,AMQQSQP1,AMQQSQP2,AMQQSQPH,AMQQSQPL,AMQQSQPQ,AMQQSQPS,AMQQSQPY,AMQQSQQQ,AMQQSQQT
+2 ; &&& AMQQSQZF ADDED
NEW AMQQSQRC,AMQQSQRD,AMQQSQSC,AMQQSQSJ,AMQQSQSN,AMQQSQSQ,AMQQSQST,AMQQSQSZ,AMQQSQTF,AMQQSQTP,AMQQSQVV,AMQQSQZL,AMQQSQP,AMQQSQZF
+3 SET %=AMQQTSTG
+4 SET AMQQSQAN=$PIECE(%,U)
+5 SET AMQQSQSN=$PIECE(%,U,2)
+6 SET AMQQSQST=$PIECE(%,U,3)
+7 SET AMQQRECV=$PIECE(%,U,5,99)
+8 SET AMQQLINK=$PIECE(AMQQRECV,U,8)
+9 SET AMQQSQAA=$PIECE(%,U,4)
+10 SET AMQQSQNN=AMQQUSQN
+11 SET AMQQSQRC=""
+12 KILL AMQQTSTG
+13 IF $DATA(AMQQXXND)
IF $DATA(AMQQYYMI)
DO AUTO
QUIT
+14 DO ^AMQQSQ
R1 IF $DATA(AMQQQUIT)
QUIT
+1 DO SETSUB
+2 SET AMQQUSQL=AMQQUSQL-1
+3 SET AMQQSQQF=AMQQSQRC
+4 KILL AMQQSQRC
+5 QUIT
+6 ;
SETSUB FOR %=1,2
SET $PIECE(AMQQCOMP,";",%)=$PIECE(AMQQRECV,U,%)
+1 SET $PIECE(AMQQCOMP,";",4)=$PIECE(AMQQRECV,U,11)
+2 SET AMQQQ=$PIECE(AMQQRECV,U,8,10)_"^1^^^^^"_AMQQCOMP_"^^^^^^"
+3 SET $PIECE(AMQQQ,U,17)=$PIECE(AMQQRECV,U,11)
+4 QUIT
+5 ;
EN1 ; ENTRY POINT FROM AMQQQ2
+1 DO VAR
DO GET
DO EXIT
+2 QUIT
+3 ;
AUTO NEW AMQQYYYY
+1 SET AMQQYYYY=AMQQMMMM
+2 SET %=AMQQXXND
+3 NEW AMQQXXND
+4 SET AMQQXXND=$EXTRACT(%,1,$LENGTH(%)-1)_","_AMQQYYMI_",1)"
+5 NEW AMQQMMMM,AMQQMMCC,AMQQMMVV,AMQQYYMI
+6 SET AMQQYYMI=0
+7 DO MULT^AMQQQ2
+8 DO R1
+9 QUIT
+10 ;
