Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMQQMUL3

AMQQMUL3.m

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