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

AMQQDO.m

Go to the documentation of this file. 
  1. 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
  1.  ;-----
  1.  ; SPECIAL AMQP VARIABLES:
  1.  ;AMQP(0)=PATIENT #
  1.  ;AMQP(1)=VISIT #
  1.  ;AMQP(2)=VISIT DATE
  1.  ;AMQP(3)=V POV #
  1.  ;AMQP(4)= V MED #
  1.  ;AMQP(5) = PROVIDER #
  1.  ;AMQP(6)=V PROCEDURE #
  1.  S AMQQOV=$S(AMQQCCLS="P":0,AMQQCCLS="D":3,AMQQCCLS="H":5,1:1)
  1.  I $D(AMQQBACK),$D(AMQQDIBT) S ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))="" Q
  1.  I $D(AMQQEN3),$D(AMQQDIBT),$D(AMQQND) S ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))="" W "." Q
  1.  I '$D(AMQQLABB) S AMQQLABB="" I $D(DUZ(2)),$D(^AUTTLOC(DUZ(2),0)) S AMQQLABB=$E($P(^(0),U,2),1,6)
  1.  I $G(AMQQMULL),$D(^UTILITY("AMQQ",$J,"AG",AMQQMULL)) D MULT G EXIT
  1.  D DISPLAY
  1. EXIT K AMQQSVAR,AMQQOV,^UTILITY("AMQQ",$J,"AG"),AMQQLDFN,%,A,I,J,Z,W,X,Y
  1.  Q
  1.  ;
  1. MULT ; ENTRY POINT FROM AMQQCMPS
  1.  F AMQQHOLD=0:0 S AMQQHOLD=$O(^UTILITY("AMQQ",$J,"AG",AMQQMULL,AMQQHOLD)) Q:'AMQQHOLD  S %=^(AMQQHOLD) D M1 I AMQP(AMQQOV)=99999999999 Q
  1.  K ^UTILITY("AMQQ",$J,"AG",AMQQMULL)
  1.  Q
  1.  ;
  1. M1 ;
  1.  I $P($G(^AMQQ(1,+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULL)),0)),U,3)=9000010.01 NEW AMQQVMDA S AMQQVMDA=$P(%,U,4)
  1.  I $G(AMQV(+$O(AMQT(999),-1)))["AUPNVHF" N AMQQDA S AMQQDA=$P(%,U,4)
  1.  I '$G(AMQQDA),$G(AMQV(+$O(AMQT(999),-1)-1))["AUPNVHF" N AMQQDA S AMQQDA=$P(%,U,4)
  1.  I $G(AMQV(+$O(AMQT(999),-1)))["AUPNVLAB" S AMQQLDFN=+$G(^AUPNVLAB(+$P(%,U,4),0)) ;PATCH XXX
  1.  S Z=(AMQQMUFV+AMQQMUNV-1)
  1.  F X=AMQQMUFV:1:Z I $D(^UTILITY("AMQQ",$J,"VAR NAME",X)) S Y=^(X) D
  1.  .S A=$P(Y,U,2)
  1.  .Q:+Y'=+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULL))
  1.  .Q:'A
  1.  .S AMQP(X)=$P(%,U,A)
  1.  I $D(AMQQYY(0)) Q
  1.  I 'AMQQOV,'$D(^DPT(AMQP(0),0)) W !,"BAD POINTER FOR PATIENT NUMBER ",AMQP(AMQQOV) Q
  1.  D DISPLAY
  1.  Q
  1.  ;
  1. DISPLAY S:'$D(AMQQTOT) AMQQTOT=0 S AMQQTOT=AMQQTOT+1
  1.  I $D(AMQQRMFL) D @AMQQRMFL Q
  1.  I $D(AMQV("OPTION")),AMQV("OPTION")="COUNT" W:$E(IOST,1,2)'="P-" $C(13),AMQQTOT Q
  1.  I $D(AMQQDIBT) S ^DIBT(AMQQDIBT,1,AMQP(AMQQOV))=""
  1.  I '$G(AMQQDLIM),AMQQTOT#(IOSL-6-(5*($E(IOST,1,2)="P-")))=1 D ^AMQQDOH I AMQP(AMQQOV)=99999999999 Q
  1.  I AMQQCCLS="D" D DD Q
  1.  I AMQQCCLS="H" D DH Q
  1.  I AMQQCCLS="V" D DV Q
  1.  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
  1.  S %=$E($P(^DPT(AMQP(0),0),U),1,$S('$G(AMQQDLIM):16,1:99))
  1.  I '$G(AMQQDLIM),$D(^DPT(AMQP(0),.01,1)) S %=$E(%,1,15)_"*"
  1.  E  I $D(^DPT(AMQP(0),.01,1)) S %=%_"*"
  1.  I $D(AMQQSUPF) S %="*****"
  1.  W !,% W $S('$G(AMQQDLIM):" ",1:U)
  1.  I $D(DUZ(2)),$D(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0)) D
  1.  .I '$G(AMQQDLIM) W ?17,$P(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0),U,2)
  1.  .E  W $S($P(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0),U,2)]"":$P(^(0),U,2),1:"NO HRN"),U
  1.  I $D(DUZ(2)),$G(AMQQDLIM),'$D(^AUPNPAT(AMQP(AMQQOV),41,DUZ(2),0)) W "NO HRN",U
  1. DIS S J=$$CHKVA(24)
  1.  F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I  I $D(AMQP(I)) D FORMAT
  1.  I $G(AMQQDVQU),$P(^AMQQ(1,+%,0),U,3)=9000010.01 W ?J,$$QUAL(AMQQVMDA) S J=J+20
  1.  I '$G(AMQQDLIM),$D(^TMP(+$G(AMQQJOB),"AMQQAPT")) D
  1.  .S AMQQEDT=+^TMP(AMQQJOB,"AMQQAPT")
  1.  .D APT^AMQQAPT(AMQP(AMQQOV),DT,AMQQEDT,$J)
  1.  Q
  1.  ;
  1. DV S Y=+^AUPNVSIT(AMQP(1),0)
  1.  X ^DD("DD")
  1.  I '$G(AMQQDLIM) W !,AMQP(1),?9,Y
  1.  E  W !,AMQP(1),U,Y,U
  1.  S J=$$CHKVA(29)
  1.  F I=9:0 S I=$O(AMQP(I)) Q:'I  I $D(^UTILITY("AMQQ",$J,"VAR NAME",I)) D FORMAT
  1.  Q
  1.  ;
  1. DD I '$G(AMQQDLIM) W !,AMQP(3)
  1.  E  W !,AMQP(3),U
  1.  S J=9
  1.  F I=9:0 S I=$O(AMQP(I)) Q:'I  I $D(^UTILITY("AMQQ",$J,"VAR NAME",I)) D FORMAT
  1.  Q
  1.  ;
  1. DH S %=$P(@AMQQ200(16)@(AMQP(5),0),U)
  1.  S Y=$P($G(@AMQQ200(6)@(AMQP(5),9999999)),U,2)
  1.  I '$G(AMQQDLIM) W !,$E(%,1,18),?19,$E(Y,1,4)
  1.  E  W !,$E(%,1,18),U,$E(Y,1,4),U
  1.  D DIS
  1.  Q
  1.  ;
  1. FORMAT S X=AMQP(I)
  1.  S %=^UTILITY("AMQQ",$J,"VAR NAME",I)
  1.  S Y=1
  1.  S A=$P(%,U,2)
  1.  S:'A A=1
  1.  I $P(%,U,5)="EXISTS" S X="+"
  1.  I $P(%,U,5)="INVERSE" S X="-"
  1.  D LABCONV
  1.  S Z=^AMQQ(1,+%,4,A,0)
  1.  S Z=$P(Z,U,6)
  1.  I X="" S X="-"
  1.  I $P(%,U,3)'="" S Z=$P(%,U,4)
  1.  I $D(AMQQTOTF(I)) K AMQQTOTF(I) S Y=0 G FOR1
  1.  I $D(^AMQQ(1,+%,4,A,1)),X'?1P,X'="SAVED",X'="NULL",Y X ^(1)
  1.  I $G(AMQQDA),$D(^AMQQ(1,+%,4,A,1)),X'?1P,X'="SAVED",X'="NULL",Y,^(1)["AUTTHF" D
  1.  .N AMQQZ
  1.  .S AMQQZ=$P($G(^AUPNVHF(AMQQDA,0)),U,6)
  1.  .I AMQQZ,$D(AMQQ(423)) D  Q:'AMQQZ
  1.  ..N COND,VALUE,T
  1.  ..S COND=$P(AMQQ(423),U)
  1.  ..S VALUE=$P(AMQQ(423),U,2)
  1.  ..S T="I "_AMQQZ_COND_VALUE
  1.  ..X T
  1.  ..S:'$T AMQQZ=""
  1.  .S:AMQQZ]"" X=$E(X,1,Z-4)_$J($E(AMQQZ,1,4),4)
  1. FOR1 I '$G(AMQQDLIM) W ?J,$E(X,1,Z)
  1.  E  W $E(X,1,Z),U
  1.  I "^765^766^767^"[(U_+$G(%)_U) W " days"
  1.  S J=J+2+Z
  1.  Q
  1. QUAL(Z) ;
  1.  I $G(Z)="" Q ""
  1.  NEW A,B,C
  1.  S A=""
  1.  S B=0 F  S B=$O(^AUPNVMSR(Z,5,B)) Q:B'=+B  D
  1.  .S C=$P($G(^AUPNVMSR(Z,5,B,0)),U) I C S A=A_$P(^GMRD(120.52,C,0),U,2)_" "
  1.  Q A
  1. LABCONV ;EP;CONVERT FOR TEMP LAB GLOBAL
  1.  Q:+%<1000!(+%'[".")
  1.  Q:$D(^AMQQ(1,+%,4))
  1.  S $P(%,U)=$P(+%,".")_($J/100000)
  1.  Q:$D(^AMQQ(1,+%,4))
  1.  N AMQQATN,AMQQATNM,AMQQXX
  1.  S AMQQXX=""
  1.  S AMQQATN=$P(%,".")
  1.  S AMQQATNM="LAB"
  1.  N A,I,J,%
  1.  D SETLAB^AMQQATAL
  1.  Q
  1.  ;
  1. EXP ; ENTRY POINT FROM METADICTIONARY
  1.  N J,Y,Z,%,SITE,VLAB
  1.  S J=$G(AMQQLDFN)
  1.  I 'J Q
  1.  S Y=$P(^LAB(60,J,0),U)
  1.  S Y=$P(Y,"(",2)
  1.  S:Y'="" Y="  ("_$E(Y,1,16)
  1.  S %=^UTILITY("AMQQ",$J,"AG",AMQQMULL,AMQQHOLD)
  1.  S Z=$P(%,U,4)
  1.  S VLAB=Z
  1.  S Z=$P($G(^AUPNVLAB(Z,11)),U)
  1.  S %=$P(%,U)
  1.  S %=$E(%,$L(%)-1,$L(%)),%=$S(%="L*":" ",%="H*":" ",%=" H":"  ",%=" L":"  ",1:"    ")
  1.  S Z=%_Z
  1.  S SITE="NO SITE RECORDED"
  1.  S %=$P($G(^AUPNVLAB(VLAB,11)),U,3)
  1.  S:$G(^LAB(61,+%,0))'="" SITE=$P(^LAB(61,%,0),U)
  1.  S X=X_Z_"   "_SITE_Y
  1.  Q
  1.  ;
  1. SUOUT ; Output transform for CHART SERVICE UNIT attribute; prints chart #s/su
  1.  N %
  1.  S X=""
  1.  S %=0
  1.  F  S %=$O(^AUPNPAT(AMQP(0),41,%)) Q:'%  D
  1.  .N %A
  1.  .S %A=$P(^AUTTLOC(%,0),U,5)
  1.  .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)
  1.  Q
  1.  ;
  1. CHKVA(C) ; RETURN C+3 IF VA, ELSE C
  1.  Q $S('$D(DUZ("AG")):C,$E(DUZ("AG"))="V":C+3,1:C)