- 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 ;
