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 ;
