- AMQQ ; IHS/CMI/THL - QUERY UTILITY ENTRY ROUTINE ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ; THIS IS THE 'DEVELOPMENT' ENTRY POINT FOR Q-MAN. THE 'PRODUCTION' ENTRY POINT IS EN^AMQQ
- ;-----
- N AMQQADAM
- S AMQQADAM=""
- START D TRAP,VAR
- AGAIN I $D(AMQQEN3) S AMQQEN31=AMQQEN3,AMQQEN3=-1 S AMQQOPT="SEARCH" G LOOP
- D ^AMQQOPT I $D(AMQQQUIT)!('$D(AMQQOPT)) G EXIT
- LOOP F D EXIT1^AMQQKILL,TRAP,@AMQQOPT I $D(AMQQQUIT)!($D(AMQQEN3))!('$D(AMQQOPT)) Q
- I $D(AMQQQUIT) K AMQQQUIT S AMQQAGIN=1 G AGAIN
- EXIT ; ENTRY POINT FROM AMQQCMPL
- I $G(AMQQETRP)]"" S $ZT=AMQQETRP K AMQQETRP
- D EXIT1^AMQQKILL
- I $D(^%ZOSF("NBRK")) X ^("NBRK")
- I '$D(AMQQXX),'$D(AMQQYY),$D(IOF) W @IOF
- D EXIT^AMQQKILL
- Q
- ;
- FAST ; ENTRY POINT FOR FAST FACTS
- SEARCH ; ENTRY POINT FROM AMQQQE
- I '$D(AMQQXX) W @IOF I $G(AMQQOPT)="SEARCH" W ?20,"***** SEARCH CRITERIA *****",!!!
- INIT S (AMQQUSQL,AMQQUATN)=1
- S (AMQQUNBC,AMQQUSQN,AMQQURGN,AMQQUQQN)=0,U="^"
- ; ALL THE AMQQU* VARIABLES ARE COUNTERS WHICH MUST EXIST IN ALL
- ; ROUTINES AT ALL LEVELS AND MUST NEVER BE NEWED
- RUN I '$D(AMQQXX) D ^AMQQ1,^AMQQQ:$D(AMQQXX) K AMQQXX I $D(AMQQQUIT) K:'AMQQQUIT AMQQQUIT Q
- I $D(AMQQXX) D EN^AMQQQ Q
- I $D(AMQQEN3),$G(AMQQCCLS)'="P" W !!!,"Sorry...the subject of your search must be a patient.",!!!,*7 H 3 Q
- AT D ^AMQQAT
- I $D(AMQQXSQF) K AMQQXSQF D LIST G AT
- I $D(AMQQQUIT),AMQQUATN=1,AMQQQ="" Q
- I $D(AMQQQUIT) K AMQQQUIT Q
- I '$D(AMQQNOET),$$VERSION^%ZOSV(1)["Cache" S X="ERROR^AMQQ",@^%ZOSF("TRAP")
- I '$D(AMQQNOET),$$VERSION^%ZOSV(1)'["Cache" S X="ERROR^AMQQ",@^%ZOSF("TRAP")
- I $D(AMQQSCPF) K AMQQSCPF G AT
- I AMQQUATN=1,AMQQQ="" Q
- I AMQQQ="" D ^AMQQCMPL K AMQQQUIT Q
- I $D(AMQQANYF) K AMQQANYF D LIST G AT
- I $D(AMQQTXMT) K AMQQTXMT G SET
- I $D(AMQQONE),'$D(AMQQMULT) D LIST G AT
- I $D(AMQQSVFL) K AMQQSVFL D LIST G AT
- SET D ^AMQQATR
- D ^AMQQATL
- D ^AMQQATS
- D LIST
- S AMQQUATN=AMQQUATN+1
- I '$D(AMQQNULL) S AMQQUNBC=AMQQUNBC+1
- K AMQQNULL
- G AT
- ;
- SAVE D ^AMQQQE
- Q
- ;
- VIEW D VIEW^AMQQOPT1
- Q
- ;
- TRAP ;TRAP
- K AMQQNOET
- I '$D(^DD("OS")) S AMQQNOET="" Q
- S %=^DD("OS"),%=$P(^DD("OS",%,0),U) I %'["CACHE",%'["MSM",%'["MICRONETICS",%'["DSM(V" S AMQQNOET="" Q
- I '$D(AMQQNOET)!($D(AMQQADAM)),$D(^%ZOSF("BRK")) X ^("BRK")
- I '$D(^%ZOSF("TRAP"))!($D(AMQQADAM)) S AMQQNOET=""
- Q:$D(AMQQNOET)
- S AMQQETRP=$ZT
- I $$VERSION^%ZOSV(1)["Cache" S X="ERR^AMQQ",@^%ZOSF("TRAP")
- E S X="ERR^AMQQ",@^%ZOSF("TRAP")
- Q
- OLDTRAP K AMQQNOET
- I '$D(^DD("OS")) S AMQQNOET="" Q
- S %=^DD("OS")
- S %=$P(^DD("OS",%,0),U)
- I %'["MSM",%'["MICRONETICS",%'["DSM(V" S AMQQNOET="" Q
- I '$D(^%ZOSF("TRAP"))!($D(AMQQADAM)) S AMQQNOET=""
- Q
- VAREN ; ENTRY POINT TO SET VARIABLES
- VAR S X=$T(AMQQ+1) S AMQQVER=$P(X,";",3)
- S X=$P(^AMQQ(8,DUZ(2),0),U,6)
- F %=3,6,16 S AMQQ200(%)=$S(X:"^VA(200)",1:("^DIC("_%_")"))
- I '$D(AMQQXX) S IOP="0;79" D ^%ZIS
- I $D(AMQQRV),$D(AMQQNV) Q
- I '$D(AMQQXX) S X=$G(^%ZIS(2,IOST(0),5)),AMQQRV=$P(X,U,4),AMQQNV=$P(X,U,5)
- E S AMQQRV=""
- I AMQQRV="" S (AMQQRV,AMQQNV)="AMQQXV",AMQQXV=""
- ;
- LIST ; ENTRY POINT FROM AMQQAT1
- I $D(AMQQXX) Q
- W !!
- F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"LIST",%)) Q:'% W ! X ^(%)
- W !!
- Q
- ;
- ERROR I '$D(AMQQNOET) X "I $P($ZE,"">"")=""<INRPT""!($P($ZE,"">"")=""<INTERRUPT"")" I W !!,"QMAN Session terminated...",!! H 2 S AMQQQUIT="" G EXIT
- D EMSG
- H 4
- D AT
- G EXIT
- ;
- EMSG W !!,"WHOOPS!!!!!!!!!!!!!"
- W !,"Something just happened which caused me to come to a grinding halt."
- W !,"Try to enter the ATTRIBUTE again, but if this problem persists you must"
- W !,"take a different approach.",!!!,*7
- Q
- ;
- ERR ; The following line contains vendor specific $Z for DSM and MSM - an
- ; an exemption to SAC 6.1.2.3 has been granted for version 2 only per
- ; memo dated 5/5/93 from J. MacArthur - This needs to be changed in
- ; the next release. **BRJ/IHS ** 6/7/93
- I $P($ZE,">")["<INRPT"!($P($ZE,">")["<INTERRUPT")!($P($ZE,">")["<DSCON") W !!,"Session terminated...",!! H 2 S AMQQQUIT="" G EXIT
- W !!,"ERROR DETECTED...Try again...If problem persists try a different approach",!!,*7
- H 4
- G LOOP:$D(AMQQOPT),EXIT
- ;
- ;
- ;
- EN ;EP; PRIMARY ENTRY POINT FOR QMAN FROM THE KERNEL MENU SYSTEM
- D ^AMQQDFN
- D START
- Q
- ;
- EN1 ; PROGRAMMER ENTRY POINT ; SCRIPT INTERFACE
- D ^AMQQDFN
- I '$D(AMQQXX) S AMQQFAIL=1 Q
- I '$D(AMQQYY) S AMQQFAIL=2 Q
- S X=$S($E(AMQQXX)'="^":$P(AMQQXX,"("),1:"")
- S Y=$S($E(AMQQYY)'="^":$P(AMQQYY,"("),1:"")
- S %="DT,DTIME,DUZ,IO,IOF,IOM,IOSL,IOXY,U,XQDIC,XQPSM,XQY,XQY0,ZTQUEUED,AMQQXX,AMQQYY,AMQQFAIL,AMQQADAM,AMQQSURV,AMQQARRY"
- S:X]"" %=%_","_X
- S:Y]"" %=%_","_Y
- S %="N ("_%_") D INDER"
- X %
- Q
- INDER ; Special Entry Point For Call From Above Execute
- S %=$E(AMQQYY,$L(AMQQYY))
- I %="("!(%=",") S X=$E(AMQQYY,1,$L(AMQQYY)-1),Y=X_$S(%="(":"",1:")") K @Y
- I '$D(AMQQYY(0)) S AMQQYY(0)=""
- D EXIT1^AMQQKILL
- D TRAP
- D VAR
- D SEARCH
- D EXIT
- Q
- ;
- EN2 ; PROGRAMMER ENTRY POINT FOR NATL LANGUAGE INTERFACE
- ; USED BY PHARMACY PKG AND OTHERS. SET AUPNPAT = PT DFN
- I '$D(AUPNPAT) Q
- D ^AMQQDFN
- S AMQQFEN2=""
- S AMQQOPT="FAST"
- S AMQQSAUT="^DPT^"_AUPNPAT_U_$P(^DPT(AUPNPAT,0),U)
- D TRAP
- D VAR
- D LOOP
- D EXIT
- K AMQQFEN2
- Q
- ;
- EN3 ; PROGRAMMER ENTRY POINT FOR SEARCH TEMPLATE SUBSTITUTION. INPUT AMQQEN3 CONTAINS THE DIBT ENTRY NUMBER AND OUTPUT RETURNS THE TOTAL NUMBER OF ENTRIES IN THE NEW TEMPLATE
- ; IF AMQQND=0, HITS NOT DISPLAYED, AMQQND=1 DOTS WILL BE DISPLAYED FOR EACH HIT
- I '$D(AMQQEN3) S AMQQEN3=-1 Q
- I AMQQEN3 S %=$P($G(^DIBT(AMQQEN3,0)),U,4) I %'=2,%'=9000001 K % S AMQQEN3=-1 Q
- D EN
- K AMQQND
- Q
- ;
- AMQQ ; IHS/CMI/THL - QUERY UTILITY ENTRY ROUTINE ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ; THIS IS THE 'DEVELOPMENT' ENTRY POINT FOR Q-MAN. THE 'PRODUCTION' ENTRY POINT IS EN^AMQQ
- +3 ;-----
- +4 NEW AMQQADAM
- +5 SET AMQQADAM=""
- START DO TRAP
- DO VAR
- AGAIN IF $DATA(AMQQEN3)
- SET AMQQEN31=AMQQEN3
- SET AMQQEN3=-1
- SET AMQQOPT="SEARCH"
- GOTO LOOP
- +1 DO ^AMQQOPT
- IF $DATA(AMQQQUIT)!('$DATA(AMQQOPT))
- GOTO EXIT
- LOOP FOR
- DO EXIT1^AMQQKILL
- DO TRAP
- DO @AMQQOPT
- IF $DATA(AMQQQUIT)!($DATA(AMQQEN3))!('$DATA(AMQQOPT))
- QUIT
- +1 IF $DATA(AMQQQUIT)
- KILL AMQQQUIT
- SET AMQQAGIN=1
- GOTO AGAIN
- EXIT ; ENTRY POINT FROM AMQQCMPL
- +1 IF $GET(AMQQETRP)]""
- SET $ZT=AMQQETRP
- KILL AMQQETRP
- +2 DO EXIT1^AMQQKILL
- +3 IF $DATA(^%ZOSF("NBRK"))
- XECUTE ^("NBRK")
- +4 IF '$DATA(AMQQXX)
- IF '$DATA(AMQQYY)
- IF $DATA(IOF)
- WRITE @IOF
- +5 DO EXIT^AMQQKILL
- +6 QUIT
- +7 ;
- FAST ; ENTRY POINT FOR FAST FACTS
- SEARCH ; ENTRY POINT FROM AMQQQE
- +1 IF '$DATA(AMQQXX)
- WRITE @IOF
- IF $GET(AMQQOPT)="SEARCH"
- WRITE ?20,"***** SEARCH CRITERIA *****",!!!
- INIT SET (AMQQUSQL,AMQQUATN)=1
- +1 SET (AMQQUNBC,AMQQUSQN,AMQQURGN,AMQQUQQN)=0
- SET U="^"
- +2 ; ALL THE AMQQU* VARIABLES ARE COUNTERS WHICH MUST EXIST IN ALL
- +3 ; ROUTINES AT ALL LEVELS AND MUST NEVER BE NEWED
- RUN IF '$DATA(AMQQXX)
- DO ^AMQQ1
- IF $DATA(AMQQXX)
- DO ^AMQQQ
- KILL AMQQXX
- IF $DATA(AMQQQUIT)
- IF 'AMQQQUIT
- KILL AMQQQUIT
- QUIT
- +1 IF $DATA(AMQQXX)
- DO EN^AMQQQ
- QUIT
- +2 IF $DATA(AMQQEN3)
- IF $GET(AMQQCCLS)'="P"
- WRITE !!!,"Sorry...the subject of your search must be a patient.",!!!,*7
- HANG 3
- QUIT
- AT DO ^AMQQAT
- +1 IF $DATA(AMQQXSQF)
- KILL AMQQXSQF
- DO LIST
- GOTO AT
- +2 IF $DATA(AMQQQUIT)
- IF AMQQUATN=1
- IF AMQQQ=""
- QUIT
- +3 IF $DATA(AMQQQUIT)
- KILL AMQQQUIT
- QUIT
- +4 IF '$DATA(AMQQNOET)
- IF $$VERSION^%ZOSV(1)["Cache"
- SET X="ERROR^AMQQ"
- SET @^%ZOSF("TRAP")
- +5 IF '$DATA(AMQQNOET)
- IF $$VERSION^%ZOSV(1)'["Cache"
- SET X="ERROR^AMQQ"
- SET @^%ZOSF("TRAP")
- +6 IF $DATA(AMQQSCPF)
- KILL AMQQSCPF
- GOTO AT
- +7 IF AMQQUATN=1
- IF AMQQQ=""
- QUIT
- +8 IF AMQQQ=""
- DO ^AMQQCMPL
- KILL AMQQQUIT
- QUIT
- +9 IF $DATA(AMQQANYF)
- KILL AMQQANYF
- DO LIST
- GOTO AT
- +10 IF $DATA(AMQQTXMT)
- KILL AMQQTXMT
- GOTO SET
- +11 IF $DATA(AMQQONE)
- IF '$DATA(AMQQMULT)
- DO LIST
- GOTO AT
- +12 IF $DATA(AMQQSVFL)
- KILL AMQQSVFL
- DO LIST
- GOTO AT
- SET DO ^AMQQATR
- +1 DO ^AMQQATL
- +2 DO ^AMQQATS
- +3 DO LIST
- +4 SET AMQQUATN=AMQQUATN+1
- +5 IF '$DATA(AMQQNULL)
- SET AMQQUNBC=AMQQUNBC+1
- +6 KILL AMQQNULL
- +7 GOTO AT
- +8 ;
- SAVE DO ^AMQQQE
- +1 QUIT
- +2 ;
- VIEW DO VIEW^AMQQOPT1
- +1 QUIT
- +2 ;
- TRAP ;TRAP
- +1 KILL AMQQNOET
- +2 IF '$DATA(^DD("OS"))
- SET AMQQNOET=""
- QUIT
- +3 SET %=^DD("OS")
- SET %=$PIECE(^DD("OS",%,0),U)
- IF %'["CACHE"
- IF %'["MSM"
- IF %'["MICRONETICS"
- IF %'["DSM(V"
- SET AMQQNOET=""
- QUIT
- +4 IF '$DATA(AMQQNOET)!($DATA(AMQQADAM))
- IF $DATA(^%ZOSF("BRK"))
- XECUTE ^("BRK")
- +5 IF '$DATA(^%ZOSF("TRAP"))!($DATA(AMQQADAM))
- SET AMQQNOET=""
- +6 IF $DATA(AMQQNOET)
- QUIT
- +7 SET AMQQETRP=$ZT
- +8 IF $$VERSION^%ZOSV(1)["Cache"
- SET X="ERR^AMQQ"
- SET @^%ZOSF("TRAP")
- +9 IF '$TEST
- SET X="ERR^AMQQ"
- SET @^%ZOSF("TRAP")
- +10 QUIT
- OLDTRAP KILL AMQQNOET
- +1 IF '$DATA(^DD("OS"))
- SET AMQQNOET=""
- QUIT
- +2 SET %=^DD("OS")
- +3 SET %=$PIECE(^DD("OS",%,0),U)
- +4 IF %'["MSM"
- IF %'["MICRONETICS"
- IF %'["DSM(V"
- SET AMQQNOET=""
- QUIT
- +5 IF '$DATA(^%ZOSF("TRAP"))!($DATA(AMQQADAM))
- SET AMQQNOET=""
- +6 QUIT
- VAREN ; ENTRY POINT TO SET VARIABLES
- VAR SET X=$TEXT(AMQQ+1)
- SET AMQQVER=$PIECE(X,";",3)
- +1 SET X=$PIECE(^AMQQ(8,DUZ(2),0),U,6)
- +2 FOR %=3,6,16
- SET AMQQ200(%)=$SELECT(X:"^VA(200)",1:("^DIC("_%_")"))
- +3 IF '$DATA(AMQQXX)
- SET IOP="0;79"
- DO ^%ZIS
- +4 IF $DATA(AMQQRV)
- IF $DATA(AMQQNV)
- QUIT
- +5 IF '$DATA(AMQQXX)
- SET X=$GET(^%ZIS(2,IOST(0),5))
- SET AMQQRV=$PIECE(X,U,4)
- SET AMQQNV=$PIECE(X,U,5)
- +6 IF '$TEST
- SET AMQQRV=""
- +7 IF AMQQRV=""
- SET (AMQQRV,AMQQNV)="AMQQXV"
- SET AMQQXV=""
- +8 ;
- LIST ; ENTRY POINT FROM AMQQAT1
- +1 IF $DATA(AMQQXX)
- QUIT
- +2 WRITE !!
- +3 FOR %=0:0
- SET %=$ORDER(^UTILITY("AMQQ",$JOB,"LIST",%))
- IF '%
- QUIT
- WRITE !
- XECUTE ^(%)
- +4 WRITE !!
- +5 QUIT
- +6 ;
- ERROR IF '$DATA(AMQQNOET)
- XECUTE "I $P($ZE,"">"")=""<INRPT""!($P($ZE,"">"")=""<INTERRUPT"")"
- IF $TEST
- WRITE !!,"QMAN Session terminated...",!!
- HANG 2
- SET AMQQQUIT=""
- GOTO EXIT
- +1 DO EMSG
- +2 HANG 4
- +3 DO AT
- +4 GOTO EXIT
- +5 ;
- EMSG WRITE !!,"WHOOPS!!!!!!!!!!!!!"
- +1 WRITE !,"Something just happened which caused me to come to a grinding halt."
- +2 WRITE !,"Try to enter the ATTRIBUTE again, but if this problem persists you must"
- +3 WRITE !,"take a different approach.",!!!,*7
- +4 QUIT
- +5 ;
- ERR ; The following line contains vendor specific $Z for DSM and MSM - an
- +1 ; an exemption to SAC 6.1.2.3 has been granted for version 2 only per
- +2 ; memo dated 5/5/93 from J. MacArthur - This needs to be changed in
- +3 ; the next release. **BRJ/IHS ** 6/7/93
- +4 IF $PIECE($ZE,">")["<INRPT"!($PIECE($ZE,">")["<INTERRUPT")!($PIECE($ZE,">")["<DSCON")
- WRITE !!,"Session terminated...",!!
- HANG 2
- SET AMQQQUIT=""
- GOTO EXIT
- +5 WRITE !!,"ERROR DETECTED...Try again...If problem persists try a different approach",!!,*7
- +6 HANG 4
- +7 IF $DATA(AMQQOPT)
- GOTO LOOP
- GOTO EXIT
- +8 ;
- +9 ;
- +10 ;
- EN ;EP; PRIMARY ENTRY POINT FOR QMAN FROM THE KERNEL MENU SYSTEM
- +1 DO ^AMQQDFN
- +2 DO START
- +3 QUIT
- +4 ;
- EN1 ; PROGRAMMER ENTRY POINT ; SCRIPT INTERFACE
- +1 DO ^AMQQDFN
- +2 IF '$DATA(AMQQXX)
- SET AMQQFAIL=1
- QUIT
- +3 IF '$DATA(AMQQYY)
- SET AMQQFAIL=2
- QUIT
- +4 SET X=$SELECT($EXTRACT(AMQQXX)'="^":$PIECE(AMQQXX,"("),1:"")
- +5 SET Y=$SELECT($EXTRACT(AMQQYY)'="^":$PIECE(AMQQYY,"("),1:"")
- +6 SET %="DT,DTIME,DUZ,IO,IOF,IOM,IOSL,IOXY,U,XQDIC,XQPSM,XQY,XQY0,ZTQUEUED,AMQQXX,AMQQYY,AMQQFAIL,AMQQADAM,AMQQSURV,AMQQARRY"
- +7 IF X]""
- SET %=%_","_X
- +8 IF Y]""
- SET %=%_","_Y
- +9 SET %="N ("_%_") D INDER"
- +10 XECUTE %
- +11 QUIT
- INDER ; Special Entry Point For Call From Above Execute
- +1 SET %=$EXTRACT(AMQQYY,$LENGTH(AMQQYY))
- +2 IF %="("!(%=",")
- SET X=$EXTRACT(AMQQYY,1,$LENGTH(AMQQYY)-1)
- SET Y=X_$SELECT(%="(":"",1:")")
- KILL @Y
- +3 IF '$DATA(AMQQYY(0))
- SET AMQQYY(0)=""
- +4 DO EXIT1^AMQQKILL
- +5 DO TRAP
- +6 DO VAR
- +7 DO SEARCH
- +8 DO EXIT
- +9 QUIT
- +10 ;
- EN2 ; PROGRAMMER ENTRY POINT FOR NATL LANGUAGE INTERFACE
- +1 ; USED BY PHARMACY PKG AND OTHERS. SET AUPNPAT = PT DFN
- +2 IF '$DATA(AUPNPAT)
- QUIT
- +3 DO ^AMQQDFN
- +4 SET AMQQFEN2=""
- +5 SET AMQQOPT="FAST"
- +6 SET AMQQSAUT="^DPT^"_AUPNPAT_U_$PIECE(^DPT(AUPNPAT,0),U)
- +7 DO TRAP
- +8 DO VAR
- +9 DO LOOP
- +10 DO EXIT
- +11 KILL AMQQFEN2
- +12 QUIT
- +13 ;
- EN3 ; PROGRAMMER ENTRY POINT FOR SEARCH TEMPLATE SUBSTITUTION. INPUT AMQQEN3 CONTAINS THE DIBT ENTRY NUMBER AND OUTPUT RETURNS THE TOTAL NUMBER OF ENTRIES IN THE NEW TEMPLATE
- +1 ; IF AMQQND=0, HITS NOT DISPLAYED, AMQQND=1 DOTS WILL BE DISPLAYED FOR EACH HIT
- +2 IF '$DATA(AMQQEN3)
- SET AMQQEN3=-1
- QUIT
- +3 IF AMQQEN3
- SET %=$PIECE($GET(^DIBT(AMQQEN3,0)),U,4)
- IF %'=2
- IF %'=9000001
- KILL %
- SET AMQQEN3=-1
- QUIT
- +4 DO EN
- +5 KILL AMQQND
- +6 QUIT
- +7 ;
