AMQQMUL3 ;IHS/CMI/THL - ICD MATCH FROM VISIT OR PROBLEM LIST ;
;;2.0;IHS PCC SUITE;**5,11**;MAY 14, 2009;Build 58
;-----
D MULT
Q
;
ICD ; ENTRY POINT FROM METADICTIONARY
S AMQP(3.1)=AMQP(.3)
I '$D(AMQP("ICD")) S AMQP("ICD")=1
I AMQP("ICD")=2 G PROB
VISIT S AMQP(.3)=$O(^AUPNVPOV("B",AMQP(.1),AMQP(.3)))
I 'AMQP(.3) S AMQP("ICD")=2,AMQP(.2)=0 G PROB
S %=$P($G(^AUPNVPOV(AMQP(.3),0)),U,2)
I '% G VISIT
I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=% Q
G VISIT
;
PROB ; ENTRY POINT FROM METADICTIONARY
S AMQP(.2)=$O(^AUPNPROB("B",AMQP(.1),AMQP(.2)))
I 'AMQP(.2) K AMQP("ICD") S AMQP(.3)=0 Q
G PROB:$P($G(^AUPNPROB(AMQP(.2),0)),U,12)="D" ;skip deleted problems
S AMQP(3.1)=AMQP(.2),%=$P($G(^AUPNPROB(AMQP(3.1),0)),U,2)
I '% G PROB
I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=%,AMQP(.3)=1 Q
G PROB
;
SPEC ; ENTRY POINT FROM METADICTIONARY ;PATCH XXX
S AMQP(.2)=$O(^BDPRECN("B",AMQP(.1),AMQP(.2)))
I 'AMQP(.2) K AMQP("ICD") S AMQP(.3)=0 Q
S AMQP(3.1)=AMQP(.2),%=$P($G(^BDPRECN(AMQP(3.1),0)),U,2)
I '% G SPEC
I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=%,AMQP(.3)=1 Q
G SPEC
;
FAMHX ; ENTRY POINT FROM METADICTIONARY
S AMQP(.2)=$O(^AUPNFH("B",AMQP(.1),AMQP(.2)))
I 'AMQP(.2) K AMQP("ICD") Q
S AMQP(3.1)=AMQP(.2)
S %=$P($G(^AUPNFH(AMQP(3.1),0)),U,2)
I '% G FAMHX
I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=% Q
G FAMHX
Q
;
PERSHX ; ENTRY POINT FROM METADICTIONARY
S AMQP(.2)=$O(^AUPNPH("B",AMQP(.1),AMQP(.2)))
I 'AMQP(.2) K AMQP("ICD") Q
S AMQP(3.1)=AMQP(.2)
S %=$P($G(^AUPNPH(AMQP(3.1),0)),U,2)
I '% G PERSHX
I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=% Q
G PERSHX
Q
;
HLTHSTAT ; ENTRY POINT FROM METADICTIONARY
S AMQP(.2)=$O(^AUPNHF("B",AMQP(.1),AMQP(.2)))
I 'AMQP(.2) Q
S AMQP(3.1)=AMQP(.2)
S %=$P($G(^AUPNHF(AMQP(3.1),0)),U,2)
I '% G HLTHSTAT
I '$D(^UTILITY("AMQQ TEMP",$J,%)) S ^(%)="",AMQP(0)=% Q
G HLTHSTAT
Q
;
TEST ; ENTRY POINT FROM METADICTIONARY
F AMQQY="^AUPNPROB","^AUPNVPOV" Q:$D(AMQQSTP) F AMQP(3.1)=0:0 Q:$D(AMQQSTP) S AMQP(3.1)=$O(@AMQQY@("AC",AMQP(0),AMQP(3.1))) Q:'AMQP(3.1) S %=+@AMQQY@(AMQP(3.1),0) I % D
.I $D(^UTILITY("AMQQ TAX",$J,AMQQX,%))+$D(^("*")),'$D(^("--")) S AMQQSTP=1 Q
.I $D(^UTILITY("AMQQ TAX",$J,AMQQX,%)),$D(^("--")) S AMQQSTP=0 Q
I '$D(AMQQSTP),$D(^UTILITY("AMQQ TAX",$J,AMQQX,"--")) S AMQQSTP=1
I $G(AMQQSTP)
TEXIT K AMQQX,AMQQY,AMQQSTP
Q
;
WEED ; ENTRY POINT FROM METADICTIONARY
S AMQQY="^AUPNPROB"
F AMQP(3.1)=0:0 Q:$D(AMQQSTP) S AMQP(3.1)=$O(@AMQQY@("AC",AMQP(0),AMQP(3.1))) Q:'AMQP(3.1) S %=+@AMQQY@(AMQP(3.1),0) I % D
.Q:$P(@AMQQY@(AMQP(3.1),0),U,12)="D"
.I $D(^UTILITY("AMQQ TAX",$J,AMQQX,%))+$D(^("*")),'$D(^("--")) S AMQQSTP=1 Q
.I $D(^UTILITY("AMQQ TAX",$J,AMQQX,%)),$D(^("--")) S AMQQSTP=0 Q
I '$D(AMQQSTP),$D(^UTILITY("AMQQ TAX",$J,AMQQX,"--")) S AMQQSTP=1
I $G(AMQQSTP)
WEXIT K AMQQX,AMQQY,AMQQSTP
Q
;
MULT ;
VAR F I=1:1:19 D
.S X=$P("GR;ID;ST;FIN;LAST;VAL1;SPEC;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I)
.S @("AMQQ"_X)=$P(AMQQX,";",I)
I '$D(AMQQAG) S AMQQAG="AG"
S AMQQ="^"_$S($P(AMQQX,";")="AUPNPROB":"AUPNPROB",$P(AMQQX,";")="AUPNPH":"AUPNPH",$P(AMQQX,";")="AUPNHF":"AUPNHF",$P(AMQQX,";")="BDPRECN":"BDPRECN",1:"AUPNFH")_$S(AMQQX'["BDPRECN":"(""AC"",AMQP(0))",1:"(""C"",AMQP(0))") ;PATCH XXX
S AMQQVAL1=+AMQQVAL1
S AMQQMSS=+AMQQMSS
S AMQQMPC=AMQQMPC+'AMQQMPC
S AMQQAG="AG"
S AMQQHOLD=0
S AMQT(AMQQT)=0
S AMQQLCNT=0
K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
I AMQQMULZ S AMQQMUNV=AMQQNVAR,AMQQMUFV=AMQQFVAR,AMQQMULL=AMQQMULZ
I '$D(@AMQQ) S AMQT(AMQQT)=0 G NULL
I AMQQSPEC="NULL" G EXIT
RUN D INC
SQ I $D(AMQV("SQ")) D ^AMQQMULS
I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)),AMQQSPEC="NULL"!(AMQQSPEC="INVERSE") K ^(AMQQUATN) G EXIT
I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) G TRUE
NULL I AMQQSPEC'="NULL",AMQQSPEC'="ANY",AMQQSPEC'="INVERSE"
E S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)="-",AMQP(AMQQFVAR)="-",AMQT(AMQQT)=1
G EXIT
TRUE I AMQQSPEC="EXISTS" K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^(AMQQUATN,1)="+",AMQP(AMQQFVAR)="+"
S AMQT(AMQQT)=1
EXIT I AMQQAG="SAG" K ^UTILITY("AMQQ",$J,"SAG",AMQQUATN)
D EXIT3^AMQQKILL
Q
;
INC F AMQQVNO=0:0 S (AMQQVNO,AMQP(3.1))=$O(@AMQQ@(AMQQVNO)) Q:'AMQQVNO D SETAG I AMQQLCNT=-1 Q
Q
;
SETAG S AMQQGLOR="^"_$P(AMQQX,";")
S %=+@AMQQGLOR@(AMQQVNO,0)
I $D(^UTILITY("AMQQ TAX",$J,AMQQVAL1,%))+$D(^("*"))+$D(^("-")) S AMQQHOLD=AMQQHOLD+1,AMQQLCNT=AMQQLCNT+1,^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVNO_U_$S(AMQQGLOR["BDPRECN":$P(@AMQQGLOR@(AMQQVNO,0),U,3),1:"")_"^^"_AMQQVNO
I AMQQSPEC="NULL"!(AMQQSPEC="EXISTS"),AMQQLCNT,'$D(AMQV("SQ")) S AMQQLCNT=-1
Q
;
NARR ; ENTRY POINT FROM METADICTIONARY
N %,Y,Z,ZZ
I '$D(^AUPNPROB(X,0)) S X="??" Q
S %=^AUPNPROB(X,0),ZZ=X
S X=""
S Y=$P(%,U,6)
S Y=$P($G(^AUTTLOC(Y,0)),U,7)
S X=Y_$P(%,U,7)_"("_$P(%,U,12)_") "
S Y=$P(%,U,5)
S Y=$$VAL^XBDIQ1(9000011,ZZ,.05) ;$P($G(^AUTNPOV(Y,0)),U)
S Y=$S($L(Y)>37:($E(Y,1,35)_"..."),1:$E(Y,1,37))
S X=X_Y
S Y=$P(%,U)
S Y=$P($$ICDDX^ICDEX(Y,"","","I"),U,2)
I Y'="" S Y=" ["_Y_"]"
S X=X_Y
Q
;
FHNARR ; ENTRY POINT FROM METADICTIONARY
N %,Y,Z,ZZ
I '$D(^AUPNFH(X,0)) S X="??" Q
S %=^AUPNFH(X,0),ZZ=X,X=""
S Y=$P(%,U,4)
S Y=$$VAL^XBDIQ1(9000014,ZZ,.04) ;$P($G(^AUTNPOV(+Y,0)),U)
S Y=$S($L(Y)>37:($E(Y,1,35)_"..."),1:$E(Y,1,37))
S X=X_Y
S Y=$P(%,U)
S Y=$P($$ICDDX^ICDEX(Y,"","","I"),U,2)
I Y'="" S Y=" ["_Y_"]"
S X=X_Y
Q
PHNARR ; ENTRY POINT FROM METADICTIONARY
N %,Y,Z
I '$D(^AUPNPH(X,0)) S X="??" Q
S %=^AUPNPH(X,0),X=""
S Y=$P(%,U,4)
S Y=$P($G(^AUTNPOV(+Y,0)),U)
S Y=$S($L(Y)>37:($E(Y,1,35)_"..."),1:$E(Y,1,37))
S X=X_Y
S Y=$P(%,U)
S Y=$P($$ICDDX^ICDEX(Y,"","","I"),U,2)
I Y'="" S Y=" ["_Y_"]"
S X=X_Y
Q
;
NOTE(S,C,V,L) ; CHECK PROBLEM NOTE
N X,Y,Z
S AMQT(L)=0
I '$D(^AUPNPROB(AMQP(S),11)) Q
S X=0
F S X=$O(^AUPNPROB(AMQP(S),11,X)) Q:'X D
.S Y=0
.F S Y=$O(^AUPNPROB(AMQP(S),11,X,11,Y)) Q:'Y S Z=$P(^(Y,0),U,3) D I AMQT(L) S (X,Y)="~" Q
..X ("I Z"_C_""""_V_""" S AMQT(L)=1")
Q
AMQQMUL3 ;IHS/CMI/THL - ICD MATCH FROM VISIT OR PROBLEM LIST ;
+1 ;;2.0;IHS PCC SUITE;**5,11**;MAY 14, 2009;Build 58
+2 ;-----
+3 DO MULT
+4 QUIT
+5 ;
ICD ; ENTRY POINT FROM METADICTIONARY
+1 SET AMQP(3.1)=AMQP(.3)
+2 IF '$DATA(AMQP("ICD"))
SET AMQP("ICD")=1
+3 IF AMQP("ICD")=2
GOTO PROB
VISIT SET AMQP(.3)=$ORDER(^AUPNVPOV("B",AMQP(.1),AMQP(.3)))
+1 IF 'AMQP(.3)
SET AMQP("ICD")=2
SET AMQP(.2)=0
GOTO PROB
+2 SET %=$PIECE($GET(^AUPNVPOV(AMQP(.3),0)),U,2)
+3 IF '%
GOTO VISIT
+4 IF '$DATA(^UTILITY("AMQQ TEMP",$JOB,%))
SET ^(%)=""
SET AMQP(0)=%
QUIT
+5 GOTO VISIT
+6 ;
PROB ; ENTRY POINT FROM METADICTIONARY
+1 SET AMQP(.2)=$ORDER(^AUPNPROB("B",AMQP(.1),AMQP(.2)))
+2 IF 'AMQP(.2)
KILL AMQP("ICD")
SET AMQP(.3)=0
QUIT
+3 ;skip deleted problems
IF $PIECE($GET(^AUPNPROB(AMQP(.2),0)),U,12)="D"
GOTO PROB
+4 SET AMQP(3.1)=AMQP(.2)
SET %=$PIECE($GET(^AUPNPROB(AMQP(3.1),0)),U,2)
+5 IF '%
GOTO PROB
+6 IF '$DATA(^UTILITY("AMQQ TEMP",$JOB,%))
SET ^(%)=""
SET AMQP(0)=%
SET AMQP(.3)=1
QUIT
+7 GOTO PROB
+8 ;
SPEC ; ENTRY POINT FROM METADICTIONARY ;PATCH XXX
+1 SET AMQP(.2)=$ORDER(^BDPRECN("B",AMQP(.1),AMQP(.2)))
+2 IF 'AMQP(.2)
KILL AMQP("ICD")
SET AMQP(.3)=0
QUIT
+3 SET AMQP(3.1)=AMQP(.2)
SET %=$PIECE($GET(^BDPRECN(AMQP(3.1),0)),U,2)
+4 IF '%
GOTO SPEC
+5 IF '$DATA(^UTILITY("AMQQ TEMP",$JOB,%))
SET ^(%)=""
SET AMQP(0)=%
SET AMQP(.3)=1
QUIT
+6 GOTO SPEC
+7 ;
FAMHX ; ENTRY POINT FROM METADICTIONARY
+1 SET AMQP(.2)=$ORDER(^AUPNFH("B",AMQP(.1),AMQP(.2)))
+2 IF 'AMQP(.2)
KILL AMQP("ICD")
QUIT
+3 SET AMQP(3.1)=AMQP(.2)
+4 SET %=$PIECE($GET(^AUPNFH(AMQP(3.1),0)),U,2)
+5 IF '%
GOTO FAMHX
+6 IF '$DATA(^UTILITY("AMQQ TEMP",$JOB,%))
SET ^(%)=""
SET AMQP(0)=%
QUIT
+7 GOTO FAMHX
+8 QUIT
+9 ;
PERSHX ; ENTRY POINT FROM METADICTIONARY
+1 SET AMQP(.2)=$ORDER(^AUPNPH("B",AMQP(.1),AMQP(.2)))
+2 IF 'AMQP(.2)
KILL AMQP("ICD")
QUIT
+3 SET AMQP(3.1)=AMQP(.2)
+4 SET %=$PIECE($GET(^AUPNPH(AMQP(3.1),0)),U,2)
+5 IF '%
GOTO PERSHX
+6 IF '$DATA(^UTILITY("AMQQ TEMP",$JOB,%))
SET ^(%)=""
SET AMQP(0)=%
QUIT
+7 GOTO PERSHX
+8 QUIT
+9 ;
HLTHSTAT ; ENTRY POINT FROM METADICTIONARY
+1 SET AMQP(.2)=$ORDER(^AUPNHF("B",AMQP(.1),AMQP(.2)))
+2 IF 'AMQP(.2)
QUIT
+3 SET AMQP(3.1)=AMQP(.2)
+4 SET %=$PIECE($GET(^AUPNHF(AMQP(3.1),0)),U,2)
+5 IF '%
GOTO HLTHSTAT
+6 IF '$DATA(^UTILITY("AMQQ TEMP",$JOB,%))
SET ^(%)=""
SET AMQP(0)=%
QUIT
+7 GOTO HLTHSTAT
+8 QUIT
+9 ;
TEST ; ENTRY POINT FROM METADICTIONARY
+1 FOR AMQQY="^AUPNPROB","^AUPNVPOV"
IF $DATA(AMQQSTP)
QUIT
FOR AMQP(3.1)=0:0
IF $DATA(AMQQSTP)
QUIT
SET AMQP(3.1)=$ORDER(@AMQQY@("AC",AMQP(0),AMQP(3.1)))
IF 'AMQP(3.1)
QUIT
SET %=+@AMQQY@(AMQP(3.1),0)
IF %
Begin DoDot:1
+2 IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQX,%))+$DATA(^("*"))
IF '$DATA(^("--"))
SET AMQQSTP=1
QUIT
+3 IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQX,%))
IF $DATA(^("--"))
SET AMQQSTP=0
QUIT
End DoDot:1
+4 IF '$DATA(AMQQSTP)
IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQX,"--"))
SET AMQQSTP=1
+5 IF $GET(AMQQSTP)
TEXIT KILL AMQQX,AMQQY,AMQQSTP
+1 QUIT
+2 ;
WEED ; ENTRY POINT FROM METADICTIONARY
+1 SET AMQQY="^AUPNPROB"
+2 FOR AMQP(3.1)=0:0
IF $DATA(AMQQSTP)
QUIT
SET AMQP(3.1)=$ORDER(@AMQQY@("AC",AMQP(0),AMQP(3.1)))
IF 'AMQP(3.1)
QUIT
SET %=+@AMQQY@(AMQP(3.1),0)
IF %
Begin DoDot:1
+3 IF $PIECE(@AMQQY@(AMQP(3.1),0),U,12)="D"
QUIT
+4 IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQX,%))+$DATA(^("*"))
IF '$DATA(^("--"))
SET AMQQSTP=1
QUIT
+5 IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQX,%))
IF $DATA(^("--"))
SET AMQQSTP=0
QUIT
End DoDot:1
+6 IF '$DATA(AMQQSTP)
IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQX,"--"))
SET AMQQSTP=1
+7 IF $GET(AMQQSTP)
WEXIT KILL AMQQX,AMQQY,AMQQSTP
+1 QUIT
+2 ;
MULT ;
VAR FOR I=1:1:19
Begin DoDot:1
+1 SET X=$PIECE("GR;ID;ST;FIN;LAST;VAL1;SPEC;UATN;MLT;T;NVAR;FVAR;ITR;NNA;STRT;MSS;MPC;MULZ;USQN",";",I)
+2 SET @("AMQQ"_X)=$PIECE(AMQQX,";",I)
End DoDot:1
+3 IF '$DATA(AMQQAG)
SET AMQQAG="AG"
+4 ;PATCH XXX
SET AMQQ="^"_$SELECT($PIECE(AMQQX,";")="AUPNPROB":"AUPNPROB",$PIECE(AMQQX,";")="AUPNPH":"AUPNPH",$PIECE(AMQQX,";")="AUPNHF":"AUPNHF",$PIECE(AMQQX,";")="BDPRECN":"BDPRECN",1:"AUPNFH")_$SELECT(AMQQX'["BDPRECN":"(""AC"",AMQP(0))",1:"(""C"",AMQP(0)
)")
+5 SET AMQQVAL1=+AMQQVAL1
+6 SET AMQQMSS=+AMQQMSS
+7 SET AMQQMPC=AMQQMPC+'AMQQMPC
+8 SET AMQQAG="AG"
+9 SET AMQQHOLD=0
+10 SET AMQT(AMQQT)=0
+11 SET AMQQLCNT=0
+12 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+13 IF AMQQMULZ
SET AMQQMUNV=AMQQNVAR
SET AMQQMUFV=AMQQFVAR
SET AMQQMULL=AMQQMULZ
+14 IF '$DATA(@AMQQ)
SET AMQT(AMQQT)=0
GOTO NULL
+15 IF AMQQSPEC="NULL"
GOTO EXIT
RUN DO INC
SQ IF $DATA(AMQV("SQ"))
DO ^AMQQMULS
+1 IF $DATA(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN))
IF AMQQSPEC="NULL"!(AMQQSPEC="INVERSE")
KILL ^(AMQQUATN)
GOTO EXIT
+2 IF $DATA(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN))
GOTO TRUE
NULL IF AMQQSPEC'="NULL"
IF AMQQSPEC'="ANY"
IF AMQQSPEC'="INVERSE"
+1 IF '$TEST
SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,1)="-"
SET AMQP(AMQQFVAR)="-"
SET AMQT(AMQQT)=1
+2 GOTO EXIT
TRUE IF AMQQSPEC="EXISTS"
KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
SET ^(AMQQUATN,1)="+"
SET AMQP(AMQQFVAR)="+"
+1 SET AMQT(AMQQT)=1
EXIT IF AMQQAG="SAG"
KILL ^UTILITY("AMQQ",$JOB,"SAG",AMQQUATN)
+1 DO EXIT3^AMQQKILL
+2 QUIT
+3 ;
INC FOR AMQQVNO=0:0
SET (AMQQVNO,AMQP(3.1))=$ORDER(@AMQQ@(AMQQVNO))
IF 'AMQQVNO
QUIT
DO SETAG
IF AMQQLCNT=-1
QUIT
+1 QUIT
+2 ;
SETAG SET AMQQGLOR="^"_$PIECE(AMQQX,";")
+1 SET %=+@AMQQGLOR@(AMQQVNO,0)
+2 IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQVAL1,%))+$DATA(^("*"))+$DATA(^("-"))
SET AMQQHOLD=AMQQHOLD+1
SET AMQQLCNT=AMQQLCNT+1
SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQHOLD)=AMQQVNO_U_$SELECT(AMQQGLOR["BDPRECN":$PIECE(@AMQQGLOR@(AMQQVNO,0),U,3),1:"")_"^^"_AMQQVNO
+3 IF AMQQSPEC="NULL"!(AMQQSPEC="EXISTS")
IF AMQQLCNT
IF '$DATA(AMQV("SQ"))
SET AMQQLCNT=-1
+4 QUIT
+5 ;
NARR ; ENTRY POINT FROM METADICTIONARY
+1 NEW %,Y,Z,ZZ
+2 IF '$DATA(^AUPNPROB(X,0))
SET X="??"
QUIT
+3 SET %=^AUPNPROB(X,0)
SET ZZ=X
+4 SET X=""
+5 SET Y=$PIECE(%,U,6)
+6 SET Y=$PIECE($GET(^AUTTLOC(Y,0)),U,7)
+7 SET X=Y_$PIECE(%,U,7)_"("_$PIECE(%,U,12)_") "
+8 SET Y=$PIECE(%,U,5)
+9 ;$P($G(^AUTNPOV(Y,0)),U)
SET Y=$$VAL^XBDIQ1(9000011,ZZ,.05)
+10 SET Y=$SELECT($LENGTH(Y)>37:($EXTRACT(Y,1,35)_"..."),1:$EXTRACT(Y,1,37))
+11 SET X=X_Y
+12 SET Y=$PIECE(%,U)
+13 SET Y=$PIECE($$ICDDX^ICDEX(Y,"","","I"),U,2)
+14 IF Y'=""
SET Y=" ["_Y_"]"
+15 SET X=X_Y
+16 QUIT
+17 ;
FHNARR ; ENTRY POINT FROM METADICTIONARY
+1 NEW %,Y,Z,ZZ
+2 IF '$DATA(^AUPNFH(X,0))
SET X="??"
QUIT
+3 SET %=^AUPNFH(X,0)
SET ZZ=X
SET X=""
+4 SET Y=$PIECE(%,U,4)
+5 ;$P($G(^AUTNPOV(+Y,0)),U)
SET Y=$$VAL^XBDIQ1(9000014,ZZ,.04)
+6 SET Y=$SELECT($LENGTH(Y)>37:($EXTRACT(Y,1,35)_"..."),1:$EXTRACT(Y,1,37))
+7 SET X=X_Y
+8 SET Y=$PIECE(%,U)
+9 SET Y=$PIECE($$ICDDX^ICDEX(Y,"","","I"),U,2)
+10 IF Y'=""
SET Y=" ["_Y_"]"
+11 SET X=X_Y
+12 QUIT
PHNARR ; ENTRY POINT FROM METADICTIONARY
+1 NEW %,Y,Z
+2 IF '$DATA(^AUPNPH(X,0))
SET X="??"
QUIT
+3 SET %=^AUPNPH(X,0)
SET X=""
+4 SET Y=$PIECE(%,U,4)
+5 SET Y=$PIECE($GET(^AUTNPOV(+Y,0)),U)
+6 SET Y=$SELECT($LENGTH(Y)>37:($EXTRACT(Y,1,35)_"..."),1:$EXTRACT(Y,1,37))
+7 SET X=X_Y
+8 SET Y=$PIECE(%,U)
+9 SET Y=$PIECE($$ICDDX^ICDEX(Y,"","","I"),U,2)
+10 IF Y'=""
SET Y=" ["_Y_"]"
+11 SET X=X_Y
+12 QUIT
+13 ;
NOTE(S,C,V,L) ; CHECK PROBLEM NOTE
+1 NEW X,Y,Z
+2 SET AMQT(L)=0
+3 IF '$DATA(^AUPNPROB(AMQP(S),11))
QUIT
+4 SET X=0
+5 FOR
SET X=$ORDER(^AUPNPROB(AMQP(S),11,X))
IF 'X
QUIT
Begin DoDot:1
+6 SET Y=0
+7 FOR
SET Y=$ORDER(^AUPNPROB(AMQP(S),11,X,11,Y))
IF 'Y
QUIT
SET Z=$PIECE(^(Y,0),U,3)
Begin DoDot:2
+8 XECUTE ("I Z"_C_""""_V_""" S AMQT(L)=1")
End DoDot:2
IF AMQT(L)
SET (X,Y)="~"
QUIT
End DoDot:1
+9 QUIT
