AMQQDO ; IHS/CMI/THL - GENERATE OUTPUT ; 09 Mar 2010 3:19 PM [ 03/28/2013 4:35 PM ]
;;2.0;IHS PCC SUITE;**4,10**;MAY 14, 2009;Build 88
;-----
; SPECIAL AMQP VARIABLES:
;AMQP(0)=PATIENT #
;AMQP(1)=VISIT #
;AMQP(2)=VISIT DATE
;AMQP(3)=V POV #
;AMQP(4)= V MED #
;AMQP(5) = PROVIDER #
;AMQP(6)=V PROCEDURE #
S AMQQOV=$S(AMQQCCLS="P":0,AMQQCCLS="D":3,AMQQCCLS="H":5,1:1)
I $D(AMQQBACK),$D(AMQQDIBT) S ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))="" Q
I $D(AMQQEN3),$D(AMQQDIBT),$D(AMQQND) S ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))="" W "." Q
I '$D(AMQQLABB) S AMQQLABB="" I $D(DUZ(2)),$D(^AUTTLOC(DUZ(2),0)) S AMQQLABB=$E($P(^(0),U,2),1,6)
I $G(AMQQMULL),$D(^UTILITY("AMQQ",$J,"AG",AMQQMULL)) D MULT G EXIT
D DISPLAY
EXIT K AMQQSVAR,AMQQOV,^UTILITY("AMQQ",$J,"AG"),AMQQLDFN,%,A,I,J,Z,W,X,Y
Q
;
MULT ; ENTRY POINT FROM AMQQCMPS
F AMQQHOLD=0:0 S AMQQHOLD=$O(^UTILITY("AMQQ",$J,"AG",AMQQMULL,AMQQHOLD)) Q:'AMQQHOLD S %=^(AMQQHOLD) D M1 I AMQP(AMQQOV)=99999999999 Q
K ^UTILITY("AMQQ",$J,"AG",AMQQMULL)
Q
;
M1 ;
I $P($G(^AMQQ(1,+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULL)),0)),U,3)=9000010.01 NEW AMQQVMDA S AMQQVMDA=$P(%,U,4)
I $G(AMQV(+$O(AMQT(999),-1)))["AUPNVHF" N AMQQDA S AMQQDA=$P(%,U,4)
I '$G(AMQQDA),$G(AMQV(+$O(AMQT(999),-1)-1))["AUPNVHF" N AMQQDA S AMQQDA=$P(%,U,4)
I $G(AMQV(+$O(AMQT(999),-1)))["AUPNVLAB" S AMQQLDFN=+$G(^AUPNVLAB(+$P(%,U,4),0)) ;PATCH XXX
S Z=(AMQQMUFV+AMQQMUNV-1)
F X=AMQQMUFV:1:Z I $D(^UTILITY("AMQQ",$J,"VAR NAME",X)) S Y=^(X) D
.S A=$P(Y,U,2)
.Q:+Y'=+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULL))
.Q:'A
.S AMQP(X)=$P(%,U,A)
I $D(AMQQYY(0)) Q
I 'AMQQOV,'$D(^DPT(AMQP(0),0)) W !,"BAD POINTER FOR PATIENT NUMBER ",AMQP(AMQQOV) Q
D DISPLAY
Q
;
DISPLAY S:'$D(AMQQTOT) AMQQTOT=0 S AMQQTOT=AMQQTOT+1
I $D(AMQQRMFL) D @AMQQRMFL Q
I $D(AMQV("OPTION")),AMQV("OPTION")="COUNT" W:$E(IOST,1,2)'="P-" $C(13),AMQQTOT Q
I $D(AMQQDIBT) S ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))=""
I '$G(AMQQDLIM),AMQQTOT#(IOSL-6-(5*($E(IOST,1,2)="P-")))=1 D ^AMQQDOH I AMQP(AMQQOV)=99999999999 Q
I AMQQCCLS="D" D DD Q
I AMQQCCLS="H" D DH Q
I AMQQCCLS="V" D DV Q
I $P($G(^DPT(AMQP(AMQQOV),0)),U)="" W !,"MISSING DATA FOR """_$S($G(AMQP(.1))'="":AMQP(.1),1:("#"_AMQP(AMQQOV)))_""". HAVE SITE MANAGER CHECK ""B"" INDEX!" S AMQQTOT=AMQQTOT-1 Q
S %=$E($P(^DPT(AMQP(0),0),U),1,$S('$G(AMQQDLIM):16,1:99))
I '$G(AMQQDLIM),$D(^DPT(AMQP(0),.01,1)) S %=$E(%,1,15)_"*"
E I $D(^DPT(AMQP(0),.01,1)) S %=%_"*"
I $D(AMQQSUPF) S %="*****"
W !,% W $S('$G(AMQQDLIM):" ",1:U)
I $D(DUZ(2)),$D(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0)) D
.I '$G(AMQQDLIM) W ?17,$P(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0),U,2)
.E W $S($P(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0),U,2)]"":$P(^(0),U,2),1:"NO HRN"),U
I $D(DUZ(2)),$G(AMQQDLIM),'$D(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0)) W "NO HRN",U
DIS S J=$$CHKVA(24)
F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I I $D(AMQP(I)) D FORMAT
I $G(AMQQDVQU),$P(^AMQQ(1,+%,0),U,3)=9000010.01 W ?J,$$QUAL(AMQQVMDA) S J=J+20
I '$G(AMQQDLIM),$D(^TMP(+$G(AMQQJOB),"AMQQAPT")) D
.S AMQQEDT=+^TMP(AMQQJOB,"AMQQAPT")
.D APT^AMQQAPT(AMQP(AMQQOV),DT,AMQQEDT,$J)
Q
;
DV S Y=+^AUPNVSIT(AMQP(1),0)
X ^DD("DD")
I '$G(AMQQDLIM) W !,AMQP(1),?9,Y
E W !,AMQP(1),U,Y,U
S J=$$CHKVA(29)
F I=9:0 S I=$O(AMQP(I)) Q:'I I $D(^UTILITY("AMQQ",$J,"VAR NAME",I)) D FORMAT
Q
;
DD I '$G(AMQQDLIM) W !,AMQP(3)
E W !,AMQP(3),U
S J=9
F I=9:0 S I=$O(AMQP(I)) Q:'I I $D(^UTILITY("AMQQ",$J,"VAR NAME",I)) D FORMAT
Q
;
DH S %=$P(@AMQQ200(16)@(AMQP(5),0),U)
S Y=$P($G(@AMQQ200(6)@(AMQP(5),9999999)),U,2)
I '$G(AMQQDLIM) W !,$E(%,1,18),?19,$E(Y,1,4)
E W !,$E(%,1,18),U,$E(Y,1,4),U
D DIS
Q
;
FORMAT S X=AMQP(I)
S %=^UTILITY("AMQQ",$J,"VAR NAME",I)
S Y=1
S A=$P(%,U,2)
S:'A A=1
I $P(%,U,5)="EXISTS" S X="+"
I $P(%,U,5)="INVERSE" S X="-"
D LABCONV
S Z=^AMQQ(1,+%,4,A,0)
S Z=$P(Z,U,6)
I X="" S X="-"
I $P(%,U,3)'="" S Z=$P(%,U,4)
I $D(AMQQTOTF(I)) K AMQQTOTF(I) S Y=0 G FOR1
I $D(^AMQQ(1,+%,4,A,1)),X'?1P,X'="SAVED",X'="NULL",Y X ^(1)
I $G(AMQQDA),$D(^AMQQ(1,+%,4,A,1)),X'?1P,X'="SAVED",X'="NULL",Y,^(1)["AUTTHF" D
.N AMQQZ
.S AMQQZ=$P($G(^AUPNVHF(AMQQDA,0)),U,6)
.I AMQQZ,$D(AMQQ(423)) D Q:'AMQQZ
..N COND,VALUE,T
..S COND=$P(AMQQ(423),U)
..S VALUE=$P(AMQQ(423),U,2)
..S T="I "_AMQQZ_COND_VALUE
..X T
..S:'$T AMQQZ=""
.S:AMQQZ]"" X=$E(X,1,Z-4)_$J($E(AMQQZ,1,4),4)
FOR1 I '$G(AMQQDLIM) W ?J,$E(X,1,Z)
E W $E(X,1,Z),U
I "^765^766^767^"[(U_+$G(%)_U) W " days"
S J=J+2+Z
Q
QUAL(Z) ;
I $G(Z)="" Q ""
NEW A,B,C
S A=""
S B=0 F S B=$O(^AUPNVMSR(Z,5,B)) Q:B'=+B D
.S C=$P($G(^AUPNVMSR(Z,5,B,0)),U) I C S A=A_$P(^GMRD(120.52,C,0),U,2)_" "
Q A
LABCONV ;EP;CONVERT FOR TEMP LAB GLOBAL
Q:+%<1000!(+%'[".")
Q:$D(^AMQQ(1,+%,4))
S $P(%,U)=$P(+%,".")_($J/100000)
Q:$D(^AMQQ(1,+%,4))
N AMQQATN,AMQQATNM,AMQQXX
S AMQQXX=""
S AMQQATN=$P(%,".")
S AMQQATNM="LAB"
N A,I,J,%
D SETLAB^AMQQATAL
Q
;
EXP ; ENTRY POINT FROM METADICTIONARY
N J,Y,Z,%,SITE,VLAB
S J=$G(AMQQLDFN)
I 'J Q
S Y=$P(^LAB(60,J,0),U)
S Y=$P(Y,"(",2)
S:Y'="" Y=" ("_$E(Y,1,16)
S %=^UTILITY("AMQQ",$J,"AG",AMQQMULL,AMQQHOLD)
S Z=$P(%,U,4)
S VLAB=Z
S Z=$P($G(^AUPNVLAB(Z,11)),U)
S %=$P(%,U)
S %=$E(%,$L(%)-1,$L(%)),%=$S(%="L*":" ",%="H*":" ",%=" H":" ",%=" L":" ",1:" ")
S Z=%_Z
S SITE="NO SITE RECORDED"
S %=$P($G(^AUPNVLAB(VLAB,11)),U,3)
S:$G(^LAB(61,+%,0))'="" SITE=$P(^LAB(61,%,0),U)
S X=X_Z_" "_SITE_Y
Q
;
SUOUT ; Output transform for CHART SERVICE UNIT attribute; prints chart #s/su
N %
S X=""
S %=0
F S %=$O(^AUPNPAT(AMQP(0),41,%)) Q:'% D
.N %A
.S %A=$P(^AUTTLOC(%,0),U,5)
.I %'=DUZ(2),$D(^UTILITY("AMQQ TAX",$J,AMQP(4101),%A))!($D(^("*"))) S:X'="" X=X_"," S X=X_$P(^AUTTLOC(%,0),U,7)_$P(^AUPNPAT(AMQP(0),41,%,0),U,2)
Q
;
CHKVA(C) ; RETURN C+3 IF VA, ELSE C
Q $S('$D(DUZ("AG")):C,$E(DUZ("AG"))="V":C+3,1:C)
AMQQDO ; IHS/CMI/THL - GENERATE OUTPUT ; 09 Mar 2010 3:19 PM [ 03/28/2013 4:35 PM ]
+1 ;;2.0;IHS PCC SUITE;**4,10**;MAY 14, 2009;Build 88
+2 ;-----
+3 ; SPECIAL AMQP VARIABLES:
+4 ;AMQP(0)=PATIENT #
+5 ;AMQP(1)=VISIT #
+6 ;AMQP(2)=VISIT DATE
+7 ;AMQP(3)=V POV #
+8 ;AMQP(4)= V MED #
+9 ;AMQP(5) = PROVIDER #
+10 ;AMQP(6)=V PROCEDURE #
+11 SET AMQQOV=$SELECT(AMQQCCLS="P":0,AMQQCCLS="D":3,AMQQCCLS="H":5,1:1)
+12 IF $DATA(AMQQBACK)
IF $DATA(AMQQDIBT)
SET ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))=""
QUIT
+13 IF $DATA(AMQQEN3)
IF $DATA(AMQQDIBT)
IF $DATA(AMQQND)
SET ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))=""
WRITE "."
QUIT
+14 IF '$DATA(AMQQLABB)
SET AMQQLABB=""
IF $DATA(DUZ(2))
IF $DATA(^AUTTLOC(DUZ(2),0))
SET AMQQLABB=$EXTRACT($PIECE(^(0),U,2),1,6)
+15 IF $GET(AMQQMULL)
IF $DATA(^UTILITY("AMQQ",$JOB,"AG",AMQQMULL))
DO MULT
GOTO EXIT
+16 DO DISPLAY
EXIT KILL AMQQSVAR,AMQQOV,^UTILITY("AMQQ",$JOB,"AG"),AMQQLDFN,%,A,I,J,Z,W,X,Y
+1 QUIT
+2 ;
MULT ; ENTRY POINT FROM AMQQCMPS
+1 FOR AMQQHOLD=0:0
SET AMQQHOLD=$ORDER(^UTILITY("AMQQ",$JOB,"AG",AMQQMULL,AMQQHOLD))
IF 'AMQQHOLD
QUIT
SET %=^(AMQQHOLD)
DO M1
IF AMQP(AMQQOV)=99999999999
QUIT
+2 KILL ^UTILITY("AMQQ",$JOB,"AG",AMQQMULL)
+3 QUIT
+4 ;
M1 ;
+1 IF $PIECE($GET(^AMQQ(1,+$GET(^UTILITY("AMQQ",$JOB,"Q",AMQQMULL)),0)),U,3)=9000010.01
NEW AMQQVMDA
SET AMQQVMDA=$PIECE(%,U,4)
+2 IF $GET(AMQV(+$ORDER(AMQT(999),-1)))["AUPNVHF"
NEW AMQQDA
SET AMQQDA=$PIECE(%,U,4)
+3 IF '$GET(AMQQDA)
IF $GET(AMQV(+$ORDER(AMQT(999),-1)-1))["AUPNVHF"
NEW AMQQDA
SET AMQQDA=$PIECE(%,U,4)
+4 ;PATCH XXX
IF $GET(AMQV(+$ORDER(AMQT(999),-1)))["AUPNVLAB"
SET AMQQLDFN=+$GET(^AUPNVLAB(+$PIECE(%,U,4),0))
+5 SET Z=(AMQQMUFV+AMQQMUNV-1)
+6 FOR X=AMQQMUFV:1:Z
IF $DATA(^UTILITY("AMQQ",$JOB,"VAR NAME",X))
SET Y=^(X)
Begin DoDot:1
+7 SET A=$PIECE(Y,U,2)
+8 IF +Y'=+$GET(^UTILITY("AMQQ",$JOB,"Q",AMQQMULL))
QUIT
+9 IF 'A
QUIT
+10 SET AMQP(X)=$PIECE(%,U,A)
End DoDot:1
+11 IF $DATA(AMQQYY(0))
QUIT
+12 IF 'AMQQOV
IF '$DATA(^DPT(AMQP(0),0))
WRITE !,"BAD POINTER FOR PATIENT NUMBER ",AMQP(AMQQOV)
QUIT
+13 DO DISPLAY
+14 QUIT
+15 ;
DISPLAY IF '$DATA(AMQQTOT)
SET AMQQTOT=0
SET AMQQTOT=AMQQTOT+1
+1 IF $DATA(AMQQRMFL)
DO @AMQQRMFL
QUIT
+2 IF $DATA(AMQV("OPTION"))
IF AMQV("OPTION")="COUNT"
IF $EXTRACT(IOST,1,2)'="P-"
WRITE $CHAR(13),AMQQTOT
QUIT
+3 IF $DATA(AMQQDIBT)
SET ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))=""
+4 IF '$GET(AMQQDLIM)
IF AMQQTOT#(IOSL-6-(5*($EXTRACT(IOST,1,2)="P-")))=1
DO ^AMQQDOH
IF AMQP(AMQQOV)=99999999999
QUIT
+5 IF AMQQCCLS="D"
DO DD
QUIT
+6 IF AMQQCCLS="H"
DO DH
QUIT
+7 IF AMQQCCLS="V"
DO DV
QUIT
+8 IF $PIECE($GET(^DPT(AMQP(AMQQOV),0)),U)=""
WRITE !,"MISSING DATA FOR """_$SELECT($GET(AMQP(.1))'="":AMQP(.1),1:("#"_AMQP(AMQQOV)))_""". HAVE SITE MANAGER CHECK ""B"" INDEX!"
SET AMQQTOT=AMQQTOT-1
QUIT
+9 SET %=$EXTRACT($PIECE(^DPT(AMQP(0),0),U),1,$SELECT('$GET(AMQQDLIM):16,1:99))
+10 IF '$GET(AMQQDLIM)
IF $DATA(^DPT(AMQP(0),.01,1))
SET %=$EXTRACT(%,1,15)_"*"
+11 IF '$TEST
IF $DATA(^DPT(AMQP(0),.01,1))
SET %=%_"*"
+12 IF $DATA(AMQQSUPF)
SET %="*****"
+13 WRITE !,%
WRITE $SELECT('$GET(AMQQDLIM):" ",1:U)
+14 IF $DATA(DUZ(2))
IF $DATA(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0))
Begin DoDot:1
+15 IF '$GET(AMQQDLIM)
WRITE ?17,$PIECE(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0),U,2)
+16 IF '$TEST
WRITE $SELECT($PIECE(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0),U,2)]"":$PIECE(^(0),U,2),1:"NO HRN"),U
End DoDot:1
+17 IF $DATA(DUZ(2))
IF $GET(AMQQDLIM)
IF '$DATA(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0))
WRITE "NO HRN",U
DIS SET J=$$CHKVA(24)
+1 FOR I=9:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",I))
IF 'I
QUIT
IF $DATA(AMQP(I))
DO FORMAT
+2 IF $GET(AMQQDVQU)
IF $PIECE(^AMQQ(1,+%,0),U,3)=9000010.01
WRITE ?J,$$QUAL(AMQQVMDA)
SET J=J+20
+3 IF '$GET(AMQQDLIM)
IF $DATA(^TMP(+$GET(AMQQJOB),"AMQQAPT"))
Begin DoDot:1
+4 SET AMQQEDT=+^TMP(AMQQJOB,"AMQQAPT")
+5 DO APT^AMQQAPT(AMQP(AMQQOV),DT,AMQQEDT,$JOB)
End DoDot:1
+6 QUIT
+7 ;
DV SET Y=+^AUPNVSIT(AMQP(1),0)
+1 XECUTE ^DD("DD")
+2 IF '$GET(AMQQDLIM)
WRITE !,AMQP(1),?9,Y
+3 IF '$TEST
WRITE !,AMQP(1),U,Y,U
+4 SET J=$$CHKVA(29)
+5 FOR I=9:0
SET I=$ORDER(AMQP(I))
IF 'I
QUIT
IF $DATA(^UTILITY("AMQQ",$JOB,"VAR NAME",I))
DO FORMAT
+6 QUIT
+7 ;
DD IF '$GET(AMQQDLIM)
WRITE !,AMQP(3)
+1 IF '$TEST
WRITE !,AMQP(3),U
+2 SET J=9
+3 FOR I=9:0
SET I=$ORDER(AMQP(I))
IF 'I
QUIT
IF $DATA(^UTILITY("AMQQ",$JOB,"VAR NAME",I))
DO FORMAT
+4 QUIT
+5 ;
DH SET %=$PIECE(@AMQQ200(16)@(AMQP(5),0),U)
+1 SET Y=$PIECE($GET(@AMQQ200(6)@(AMQP(5),9999999)),U,2)
+2 IF '$GET(AMQQDLIM)
WRITE !,$EXTRACT(%,1,18),?19,$EXTRACT(Y,1,4)
+3 IF '$TEST
WRITE !,$EXTRACT(%,1,18),U,$EXTRACT(Y,1,4),U
+4 DO DIS
+5 QUIT
+6 ;
FORMAT SET X=AMQP(I)
+1 SET %=^UTILITY("AMQQ",$JOB,"VAR NAME",I)
+2 SET Y=1
+3 SET A=$PIECE(%,U,2)
+4 IF 'A
SET A=1
+5 IF $PIECE(%,U,5)="EXISTS"
SET X="+"
+6 IF $PIECE(%,U,5)="INVERSE"
SET X="-"
+7 DO LABCONV
+8 SET Z=^AMQQ(1,+%,4,A,0)
+9 SET Z=$PIECE(Z,U,6)
+10 IF X=""
SET X="-"
+11 IF $PIECE(%,U,3)'=""
SET Z=$PIECE(%,U,4)
+12 IF $DATA(AMQQTOTF(I))
KILL AMQQTOTF(I)
SET Y=0
GOTO FOR1
+13 IF $DATA(^AMQQ(1,+%,4,A,1))
IF X'?1P
IF X'="SAVED"
IF X'="NULL"
IF Y
XECUTE ^(1)
+14 IF $GET(AMQQDA)
IF $DATA(^AMQQ(1,+%,4,A,1))
IF X'?1P
IF X'="SAVED"
IF X'="NULL"
IF Y
IF ^(1)["AUTTHF"
Begin DoDot:1
+15 NEW AMQQZ
+16 SET AMQQZ=$PIECE($GET(^AUPNVHF(AMQQDA,0)),U,6)
+17 IF AMQQZ
IF $DATA(AMQQ(423))
Begin DoDot:2
+18 NEW COND,VALUE,T
+19 SET COND=$PIECE(AMQQ(423),U)
+20 SET VALUE=$PIECE(AMQQ(423),U,2)
+21 SET T="I "_AMQQZ_COND_VALUE
+22 XECUTE T
+23 IF '$TEST
SET AMQQZ=""
End DoDot:2
IF 'AMQQZ
QUIT
+24 IF AMQQZ]""
SET X=$EXTRACT(X,1,Z-4)_$JUSTIFY($EXTRACT(AMQQZ,1,4),4)
End DoDot:1
FOR1 IF '$GET(AMQQDLIM)
WRITE ?J,$EXTRACT(X,1,Z)
+1 IF '$TEST
WRITE $EXTRACT(X,1,Z),U
+2 IF "^765^766^767^"[(U_+$GET(%)_U)
WRITE " days"
+3 SET J=J+2+Z
+4 QUIT
QUAL(Z) ;
+1 IF $GET(Z)=""
QUIT ""
+2 NEW A,B,C
+3 SET A=""
+4 SET B=0
FOR
SET B=$ORDER(^AUPNVMSR(Z,5,B))
IF B'=+B
QUIT
Begin DoDot:1
+5 SET C=$PIECE($GET(^AUPNVMSR(Z,5,B,0)),U)
IF C
SET A=A_$PIECE(^GMRD(120.52,C,0),U,2)_" "
End DoDot:1
+6 QUIT A
LABCONV ;EP;CONVERT FOR TEMP LAB GLOBAL
+1 IF +%<1000!(+%'[".")
QUIT
+2 IF $DATA(^AMQQ(1,+%,4))
QUIT
+3 SET $PIECE(%,U)=$PIECE(+%,".")_($JOB/100000)
+4 IF $DATA(^AMQQ(1,+%,4))
QUIT
+5 NEW AMQQATN,AMQQATNM,AMQQXX
+6 SET AMQQXX=""
+7 SET AMQQATN=$PIECE(%,".")
+8 SET AMQQATNM="LAB"
+9 NEW A,I,J,%
+10 DO SETLAB^AMQQATAL
+11 QUIT
+12 ;
EXP ; ENTRY POINT FROM METADICTIONARY
+1 NEW J,Y,Z,%,SITE,VLAB
+2 SET J=$GET(AMQQLDFN)
+3 IF 'J
QUIT
+4 SET Y=$PIECE(^LAB(60,J,0),U)
+5 SET Y=$PIECE(Y,"(",2)
+6 IF Y'=""
SET Y=" ("_$EXTRACT(Y,1,16)
+7 SET %=^UTILITY("AMQQ",$JOB,"AG",AMQQMULL,AMQQHOLD)
+8 SET Z=$PIECE(%,U,4)
+9 SET VLAB=Z
+10 SET Z=$PIECE($GET(^AUPNVLAB(Z,11)),U)
+11 SET %=$PIECE(%,U)
+12 SET %=$EXTRACT(%,$LENGTH(%)-1,$LENGTH(%))
SET %=$SELECT(%="L*":" ",%="H*":" ",%=" H":" ",%=" L":" ",1:" ")
+13 SET Z=%_Z
+14 SET SITE="NO SITE RECORDED"
+15 SET %=$PIECE($GET(^AUPNVLAB(VLAB,11)),U,3)
+16 IF $GET(^LAB(61,+%,0))'=""
SET SITE=$PIECE(^LAB(61,%,0),U)
+17 SET X=X_Z_" "_SITE_Y
+18 QUIT
+19 ;
SUOUT ; Output transform for CHART SERVICE UNIT attribute; prints chart #s/su
+1 NEW %
+2 SET X=""
+3 SET %=0
+4 FOR
SET %=$ORDER(^AUPNPAT(AMQP(0),41,%))
IF '%
QUIT
Begin DoDot:1
+5 NEW %A
+6 SET %A=$PIECE(^AUTTLOC(%,0),U,5)
+7 IF %'=DUZ(2)
IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQP(4101),%A))!($DATA(^("*")))
IF X'=""
SET X=X_","
SET X=X_$PIECE(^AUTTLOC(%,0),U,7)_$PIECE(^AUPNPAT(AMQP(0),41,%,0),U,2)
End DoDot:1
+8 QUIT
+9 ;
CHKVA(C) ; RETURN C+3 IF VA, ELSE C
+1 QUIT $SELECT('$DATA(DUZ("AG")):C,$EXTRACT(DUZ("AG"))="V":C+3,1:C)