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

MCPOS02A.m

Go to the documentation of this file.
  1. MCPOS02A ;HIRMFO/DAD-NEW PERSON CONVERSION EXCEPTION REPORT ;6/6/96 14:48
  1. ;;2.3;Medicine;;09/13/1996
  1. ;
  1. K %ZIS,IOP S %ZIS="Q",IOP=$G(^XTMP("MC","DEV")) I IOP="" K IOP
  1. D ^%ZIS G:POP EXIT
  1. I $D(IO("Q")) D G EXIT
  1. . N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1. . S ZTRTN="TASK^MCPOS02A"
  1. . S ZTSAVE("^TMP(""MCPOS02"",$J,")=""
  1. . S ZTDESC="Medicine New Person Conversion Exception Report"
  1. . S ZTDTH=$H
  1. . D ^%ZTLOAD
  1. . Q
  1. TASK ;
  1. S (MCEXIT,MCFOUND)=0,MCPAGE=1,MCTODAY=$$FMTE^XLFDT($$DT^XLFDT)
  1. K MCUNDL S $P(MCUNDL,"=",81)=""
  1. U IO D HEADER
  1. S MCFILE=0
  1. F S MCFILE=$O(^TMP("MCPOS02",$J,MCFILE)) Q:MCFILE'>0!MCEXIT D
  1. . I $P(^TMP("MCPOS02",$J,MCFILE),U,2)'>0 Q
  1. . W !!,MCFILE
  1. . S MCFLD=0
  1. . F S MCFLD=$O(^TMP("MCPOS02",$J,MCFILE,MCFLD)) Q:MCFLD'>0!MCEXIT D
  1. .. I $P(^TMP("MCPOS02",$J,MCFILE,MCFLD),U,2)'>0 Q
  1. .. W ?8,MCFLD
  1. .. S MCD0=0
  1. .. F S MCD0=$O(^TMP("MCPOS02",$J,MCFILE,MCFLD,MCD0)) Q:MCD0'>0!MCEXIT D
  1. ... S MCDATA=^TMP("MCPOS02",$J,MCFILE,MCFLD,MCD0)
  1. ... S X=$P(MCDATA,U),MC6=$P(X,";"),MC6(0)=$P(X,";",2)
  1. ... S X=$P(MCDATA,U,2),MC16=$P(X,";"),MC16(0)=$P(X,";",2)
  1. ... S X=$P(MCDATA,U,3),MC200=$P(X,";"),MC200(0)=$P(X,";",2)
  1. ... S MCERROR=$P(MCDATA,U,4)
  1. ... D PRINT
  1. ... Q
  1. .. Q
  1. . Q
  1. I 'MCFOUND W !!,"No exceptions found."
  1. ;
  1. EXIT ;
  1. D ^%ZISC
  1. I '$D(XPDNM),$D(ZTQUEUED) S ZTREQ="@"
  1. K %ZIS,DIR,DIRUT,DTOUT,DUOUT,MC16,MC200,MC6,MCD0,MCDATA,MCERROR,MCEXIT
  1. K MCFILE,MCFLD,MCFOUND,MCPAGE,MCTODAY,MCUNDL,POP,X,Y,ZTDESC,ZTRTN
  1. K ^TMP("MCPOS02",$J)
  1. Q
  1. ;
  1. PRINT ;
  1. W ?14,MCD0
  1. W ?25,MC6,?36,MC16,?47,MC200,?58,MCERROR
  1. W !?15,MC6(0),?50,MC16(0),!!
  1. I $Y>(IOSL-6) D PAUSE,HEADER
  1. S MCFOUND=1
  1. Q
  1. PAUSE ;
  1. I $E(IOST,1,2)="C-" D
  1. . N DIR S DIR(0)="E" D ^DIR S MCEXIT=$S(Y'>0:1,1:0)
  1. . Q
  1. Q
  1. ;
  1. I MCEXIT Q
  1. W:($E(IOST,1,2)="C-")!(MCPAGE>1) @IOF
  1. W !?21,"Medicine New Person Exception Report",?68,MCTODAY
  1. W !?68,"Page: ",MCPAGE S MCPAGE=MCPAGE+1
  1. W !,"File",?8,"Field",?14,"IEN"
  1. W ?25,"P==>6",?36,"P==>16",?47,"P==>200",?58,"Error Message"
  1. W !?15,"Provider Name",?50,"Person Name",!,MCUNDL,!
  1. Q