- AMQQSQA ; IHS/CMI/THL - AMQQSQ SUBROUTINE GETS FUNCTIONS ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;-----
- VAR K AMQQSQNT,AMQQSQQT,AMQQSQDV
- I $D(AMQQYYMI) D AUTO G F1
- RUN S AMQQSQQQ=$S(AMQQSQFN=1:"First",1:"Next")_$S($D(AMQQGVF):" generic visit condition",1:(" condition of """_AMQQSQSJ_""""))_": "
- FUN W:'$D(AMQQXX) ! D ^AMQQSQA0
- F1 I $G(AMQQSQQT)'="QUIT",$D(Y),+Y=0 S AMQQQUIT="" W:'$D(AMQQXX) " ??",*7
- I $D(AMQQSQQT)!$D(AMQQQUIT) G EXIT
- I ((+Y=306)&(AMQQSQSN'=253))!(+Y=307) S AMQQSQQQ="Condition: ",AMQQSQDV=+Y G FUN
- D SET
- I $D(AMQQSQVV) K AMQQSQVV G EXIT
- I AMQQSQN=306,AMQQSQSN=253 D ^AMQQSQBP S AMQQSQCT="B" G EXIT
- I AMQQSQSN=258!(AMQQSQSN=257),AMQQSQN=306 D ^AMQQSQVS S AMQQSQCT="B" G EXIT
- I "NC"[AMQQSQCT S AMQQSQCV="" G EXIT
- D ^AMQQSQA1
- I $D(AMQQQUIT) K AMQQQUIT G RUN
- EXIT K %,AMQQSQDV,AMQQZSQL,AMQQSQRD,AMQQLCOF,%A,%B,A,B,C,D,I,S,Z
- Q
- ;
- SET S AMQQSQN=+Y,AMQQSQNM=$P(Y,U,2),AMQQSQCT=$P(^AMQQ(5,+Y,0),U,20),AMQQSQTP=$P(^(0),U,21),AMQQSQFL=$P(^(0),U,22),AMQQSQBS=$P(^(0),U,6),AMQQSQNC=$P(^(0),U,8),%=$P(^(0),U,7),AMQQSQF1=$P(%,";"),AMQQSQF2="AMQQF"_$P(%,";",2)
- I AMQQSQN=402 S AMQQSQCT="V" ; VISIT;POV
- I $D(AMQQSQNT) S AMQQSQNM=$S(AMQQSQNM="IS":"IS NOT",1:("NOT "_AMQQSQNM))
- I '$D(AMQQXX),"TO"[AMQQSQCT,'$D(AMQQSVAL) W !,"Enter the value which goes with ",AMQQSQNM,"; e.g., ",AMQQSQNM," 3, ",AMQQSQNM," 10, etc."
- Q
- ;
- AUTO ; ENTER SUBQUERY BY SCRIPT
- S AMQQYYMI=$O(@AMQQXXND@(AMQQYYMI))
- I 'AMQQYYMI S AMQQSQQT="" Q
- S AMQQMMMM=@AMQQXXND@(AMQQYYMI,1),(Y,AMQQMMCC)=$P(AMQQMMMM,";"),AMQQMMVV=$P(AMQQMMMM,";",2,3)
- N X S X=AMQQMMMM D SCK^AMQQSQA0
- I $D(AMQQYYMS) K AMQQYYMS S AMQQSQQT="" Q
- Q
- ;
- AMQQSQA ; IHS/CMI/THL - AMQQSQ SUBROUTINE GETS FUNCTIONS ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;-----
- VAR KILL AMQQSQNT,AMQQSQQT,AMQQSQDV
- +1 IF $DATA(AMQQYYMI)
- DO AUTO
- GOTO F1
- RUN SET AMQQSQQQ=$SELECT(AMQQSQFN=1:"First",1:"Next")_$SELECT($DATA(AMQQGVF):" generic visit condition",1:(" condition of """_AMQQSQSJ_""""))_": "
- FUN IF '$DATA(AMQQXX)
- WRITE !
- DO ^AMQQSQA0
- F1 IF $GET(AMQQSQQT)'="QUIT"
- IF $DATA(Y)
- IF +Y=0
- SET AMQQQUIT=""
- IF '$DATA(AMQQXX)
- WRITE " ??",*7
- +1 IF $DATA(AMQQSQQT)!$DATA(AMQQQUIT)
- GOTO EXIT
- +2 IF ((+Y=306)&(AMQQSQSN'=253))!(+Y=307)
- SET AMQQSQQQ="Condition: "
- SET AMQQSQDV=+Y
- GOTO FUN
- +3 DO SET
- +4 IF $DATA(AMQQSQVV)
- KILL AMQQSQVV
- GOTO EXIT
- +5 IF AMQQSQN=306
- IF AMQQSQSN=253
- DO ^AMQQSQBP
- SET AMQQSQCT="B"
- GOTO EXIT
- +6 IF AMQQSQSN=258!(AMQQSQSN=257)
- IF AMQQSQN=306
- DO ^AMQQSQVS
- SET AMQQSQCT="B"
- GOTO EXIT
- +7 IF "NC"[AMQQSQCT
- SET AMQQSQCV=""
- GOTO EXIT
- +8 DO ^AMQQSQA1
- +9 IF $DATA(AMQQQUIT)
- KILL AMQQQUIT
- GOTO RUN
- EXIT KILL %,AMQQSQDV,AMQQZSQL,AMQQSQRD,AMQQLCOF,%A,%B,A,B,C,D,I,S,Z
- +1 QUIT
- +2 ;
- SET SET AMQQSQN=+Y
- SET AMQQSQNM=$PIECE(Y,U,2)
- SET AMQQSQCT=$PIECE(^AMQQ(5,+Y,0),U,20)
- SET AMQQSQTP=$PIECE(^(0),U,21)
- SET AMQQSQFL=$PIECE(^(0),U,22)
- SET AMQQSQBS=$PIECE(^(0),U,6)
- SET AMQQSQNC=$PIECE(^(0),U,8)
- SET %=$PIECE(^(0),U,7)
- SET AMQQSQF1=$PIECE(%,";")
- SET AMQQSQF2="AMQQF"_$PIECE(%,";",2)
- +1 ; VISIT;POV
- IF AMQQSQN=402
- SET AMQQSQCT="V"
- +2 IF $DATA(AMQQSQNT)
- SET AMQQSQNM=$SELECT(AMQQSQNM="IS":"IS NOT",1:("NOT "_AMQQSQNM))
- +3 IF '$DATA(AMQQXX)
- IF "TO"[AMQQSQCT
- IF '$DATA(AMQQSVAL)
- WRITE !,"Enter the value which goes with ",AMQQSQNM,"; e.g., ",AMQQSQNM," 3, ",AMQQSQNM," 10, etc."
- +4 QUIT
- +5 ;
- AUTO ; ENTER SUBQUERY BY SCRIPT
- +1 SET AMQQYYMI=$ORDER(@AMQQXXND@(AMQQYYMI))
- +2 IF 'AMQQYYMI
- SET AMQQSQQT=""
- QUIT
- +3 SET AMQQMMMM=@AMQQXXND@(AMQQYYMI,1)
- SET (Y,AMQQMMCC)=$PIECE(AMQQMMMM,";")
- SET AMQQMMVV=$PIECE(AMQQMMMM,";",2,3)
- +4 NEW X
- SET X=AMQQMMMM
- DO SCK^AMQQSQA0
- +5 IF $DATA(AMQQYYMS)
- KILL AMQQYYMS
- SET AMQQSQQT=""
- QUIT
- +6 QUIT
- +7 ;
