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

AMQQRMA1.m

Go to the documentation of this file. 
  1. AMQQRMA1 ; IHS/CMI/THL - MAKES AGE BIN REPORTS ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;-----
  1.  I '$D(AMQQBZZZ) S (AMQQBZZZ,AMQQBXXX)=0
  1.  S AMQQBZZZ=AMQQBZZZ+1
  1. VAR S AMQQBDFN=AMQP(0)
  1.  S AMQQBVAL=AMQP(+AMQQRMA)
  1.  I '$D(^DPT(AMQQBDFN)) D FAIL Q
  1.  I AMQQRMA="" S AMQQBVAL=""
  1.  S AMQQBDOB=$P(^DPT(AMQQBDFN,0),U,3)
  1.  I AMQQBDOB="" D FAIL Q
  1.  I IOST["C-",AMQQBZZZ>1 W $C(13),AMQQBZZZ I AMQQBXXX W "  (",AMQQBXXX,")"
  1.  I AMQQBVAL="" S AMQQBVAL="UNSPECIFIED"
  1.  I $D(AMQQBBIN) D ATT Q
  1.  S AMQQBNN=AMQQRMB
  1.  S AMQQBA=""
  1.  I IOST["C-" W !!!!,"CRUNCH, CRUNCH....",!!
  1.  K ^UTILITY("BIN",$J)
  1.  F I=1:1 S AMQQBX=$P(AMQQBNN,";",I) Q:AMQQBX=""  D SETA
  1.  S AMQQBBIN=AMQQBA
  1.  S G="^UTILITY(""AMQQ"",$J,""BIN"")"
  1.  F I=1:1:$L(AMQQBA,";") S @G@("B",I)=0
  1.  D ATT
  1.  Q
  1.  ;
  1. FAIL S AMQQBXXX=AMQQBXXX+1
  1.  I AMQQBZZZ>1 W $C(13),AMQQBZZZ,"  (",AMQQBXXX,")"
  1.  Q
  1.  ;
  1. SETA S AMQQBY=$P(AMQQBX,":")
  1.  S AMQQBZ=$P(AMQQBX,":",2)
  1.  I AMQQBA'="" S AMQQBA=AMQQBA_";"
  1.  S AMQQBA=AMQQBA_(AMQQDTE+1-(10000*(AMQQBZ+1)))_":"_(AMQQDTE-(AMQQBY*10000))
  1.  Q
  1.  ;
  1. ATT S AMQQBA=AMQQBBIN
  1.  F I=1:1 S AMQQBNN=$P(AMQQBA,";",I) Q:AMQQBNN=""  S AMQQBX=$P(AMQQBNN,":"),AMQQBY=$P(AMQQBNN,":",2) I AMQQBDOB'<AMQQBX,AMQQBDOB'>AMQQBY D SETV Q
  1.  Q
  1.  ;
  1. SETV S:$G(AMQQBVAL)="" AMQQBVAL="UNSPECIFIED"
  1.  I '$D(@G@("V",AMQQBVAL)) S ^(AMQQBVAL)=0
  1.  S @G@("V",AMQQBVAL)=@G@("V",AMQQBVAL)+1
  1.  S @G@("B",I)=@G@("B",I)+1
  1.  I '$D(@G@(1,AMQQBVAL,I)) S ^(I)=0
  1.  S @G@(1,AMQQBVAL,I)=@G@(1,AMQQBVAL,I)+1
  1.  Q
  1.  ;
  1. PRINT ; ENTRY POINT
  1.  I IOST["P" D
  1.  .N AMQQRV,AMQQXV,AMQQNV
  1.  .S AMQQXV=""
  1.  .S (AMQQNV,AMQQRV)="AMQQXV"
  1.  .D COVER^AMQQCMPP
  1.  D HEADER
  1. BLVAR S G="^UTILITY(""AMQQ"",$J,""BIN"")"
  1.  S N=""
  1.  I AMQQRMA="" G TOT
  1.  F AMQQBLIN=1:1 S I=0,N=$O(@G@(1,N)) Q:N=""  D:'(AMQQBLIN#(IOSL-4)) PAUSE Q:AMQQBLIN=999999  D TRANS,B1
  1. TOT W !!,"TOTAL"
  1.  S (I,AMQQBZ)=0
  1.  F J=16:7 S I=$O(@G@("B",I)) Q:'I  W ?J,^(I) S AMQQBZ=AMQQBZ+^(I)
  1.  W ?J,AMQQBZ
  1.  I $D(AMQQBXXX),AMQQBXXX W !!,AMQQBXXX," ENTR",$S(AMQQBXXX>1:"IES",1:"Y")," NOT INCLUDED BECAUSE OF BAD POINTERS OR LACK OF DOB"
  1.  I IOST'?1"C-".E W @IOF D ^%ZISC G EXIT
  1.  D ^%ZISC
  1.  R !!,"<>",AMQQBX:DTIME
  1. EXIT K ^UTILITY("AMQQ",$J,"BIN"),X,Y,Z,AMQQBNN,AMQQBVAL,AMQQBAV,AMQQBDFN,AMQQBDOB,AMQQBSNA,AMQQBSNO,A,G,AMQQBZZZ,AMQQBXXX,AMQQBLIN,AMQQBBIN,N,AMQQBA,AMQQBX,AMQQBY,AMQQBZ,AMQQRMA,AMQQRMB,AMQQRMFL,%,A,I,J,AMQQDTE
  1.  Q
  1.  ;
  1. B1 F J=16:7 S I=I+1 Q:I>$L(AMQQRMB,";")  W ?J,$S($D(@G@(1,N,I)):^(I),1:".") I I+1>$L(AMQQRMB,";") W ?(J+7),@G@("V",N) Q
  1.  Q
  1.  ;
  1. PAUSE I IOST["C-" R !,"<>",AMQQBQ:DTIME S:'$T!(AMQQBQ=U) AMQQBLIN=999999 K AMQQBQ
  1.  D HEADER
  1.  Q
  1.  ;
  1.  W !,?35,"AGE GROUPS",!
  1.  S AMQQBSNA=$P(AMQQRMA,";",3)
  1.  I AMQQBSNA="" S AMQQBSNA="ATTRIBUTE"
  1.  S AMQQBNN=$E(AMQQBSNA,1,12)
  1.  I $L(AMQQBNN)<12 S AMQQBNN=AMQQBNN_$J("",12-$L(AMQQBNN))
  1.  W AMQQBNN
  1.  S AMQQBNN=AMQQRMB
  1.  S AMQQBI=0
  1.  S AMQQBJ=""
  1.  F AMQQBJ=14:7 S AMQQBI=AMQQBI+1,AMQQBX=$P(AMQQBNN,";",AMQQBI) Q:AMQQBX=""  D
  1.  .W ?(AMQQBJ+($P(AMQQBX,":",2)=199)),$S($P(AMQQBX,":")=$P(AMQQBX,":",2):"  ",1:($P(AMQQBX,":")_$S($P(AMQQBX,":",2)=199:"+",1:"-"))) I $P(AMQQBX,":",2)'=199 W $P(AMQQBX,":",2)
  1.  W ?(AMQQBJ+2),"TOT"
  1.  S AMQQBX=""
  1.  S $P(AMQQBX,"-",80)=""
  1.  W !,AMQQBX
  1.  K AMQQBI,AMQQBJ,AMQQBX
  1.  Q
  1.  ;
  1. TRANS N X,%
  1.  S X=N
  1.  S %=$P(AMQQRMA,";",2)
  1.  I %="" W !,$E(X,1,12) Q
  1.  X %
  1.  W !,$E(X,1,12)
  1.  Q
  1.  ;