MCPOS02A ;HIRMFO/DAD-NEW PERSON CONVERSION EXCEPTION REPORT ;6/6/96 14:48
;;2.3;Medicine;;09/13/1996
;
K %ZIS,IOP S %ZIS="Q",IOP=$G(^XTMP("MC","DEV")) I IOP="" K IOP
D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
. S ZTRTN="TASK^MCPOS02A"
. S ZTSAVE("^TMP(""MCPOS02"",$J,")=""
. S ZTDESC="Medicine New Person Conversion Exception Report"
. S ZTDTH=$H
. D ^%ZTLOAD
. Q
TASK ;
S (MCEXIT,MCFOUND)=0,MCPAGE=1,MCTODAY=$$FMTE^XLFDT($$DT^XLFDT)
K MCUNDL S $P(MCUNDL,"=",81)=""
U IO D HEADER
S MCFILE=0
F S MCFILE=$O(^TMP("MCPOS02",$J,MCFILE)) Q:MCFILE'>0!MCEXIT D
. I $P(^TMP("MCPOS02",$J,MCFILE),U,2)'>0 Q
. W !!,MCFILE
. S MCFLD=0
. F S MCFLD=$O(^TMP("MCPOS02",$J,MCFILE,MCFLD)) Q:MCFLD'>0!MCEXIT D
.. I $P(^TMP("MCPOS02",$J,MCFILE,MCFLD),U,2)'>0 Q
.. W ?8,MCFLD
.. S MCD0=0
.. F S MCD0=$O(^TMP("MCPOS02",$J,MCFILE,MCFLD,MCD0)) Q:MCD0'>0!MCEXIT D
... S MCDATA=^TMP("MCPOS02",$J,MCFILE,MCFLD,MCD0)
... S X=$P(MCDATA,U),MC6=$P(X,";"),MC6(0)=$P(X,";",2)
... S X=$P(MCDATA,U,2),MC16=$P(X,";"),MC16(0)=$P(X,";",2)
... S X=$P(MCDATA,U,3),MC200=$P(X,";"),MC200(0)=$P(X,";",2)
... S MCERROR=$P(MCDATA,U,4)
... D PRINT
... Q
.. Q
. Q
I 'MCFOUND W !!,"No exceptions found."
;
EXIT ;
D ^%ZISC
I '$D(XPDNM),$D(ZTQUEUED) S ZTREQ="@"
K %ZIS,DIR,DIRUT,DTOUT,DUOUT,MC16,MC200,MC6,MCD0,MCDATA,MCERROR,MCEXIT
K MCFILE,MCFLD,MCFOUND,MCPAGE,MCTODAY,MCUNDL,POP,X,Y,ZTDESC,ZTRTN
K ^TMP("MCPOS02",$J)
Q
;
PRINT ;
W ?14,MCD0
W ?25,MC6,?36,MC16,?47,MC200,?58,MCERROR
W !?15,MC6(0),?50,MC16(0),!!
I $Y>(IOSL-6) D PAUSE,HEADER
S MCFOUND=1
Q
PAUSE ;
I $E(IOST,1,2)="C-" D
. N DIR S DIR(0)="E" D ^DIR S MCEXIT=$S(Y'>0:1,1:0)
. Q
Q
;
I MCEXIT Q
W:($E(IOST,1,2)="C-")!(MCPAGE>1) @IOF
W !?21,"Medicine New Person Exception Report",?68,MCTODAY
W !?68,"Page: ",MCPAGE S MCPAGE=MCPAGE+1
W !,"File",?8,"Field",?14,"IEN"
W ?25,"P==>6",?36,"P==>16",?47,"P==>200",?58,"Error Message"
W !?15,"Provider Name",?50,"Person Name",!,MCUNDL,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS02A 2071 printed Apr 09, 2024@21:18:40 Page 2
MCPOS02A ;HIRMFO/DAD-NEW PERSON CONVERSION EXCEPTION REPORT ;6/6/96 14:48
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 KILL %ZIS,IOP
SET %ZIS="Q"
SET IOP=$GET(^XTMP("MC","DEV"))
IF IOP=""
KILL IOP
+4 DO ^%ZIS
if POP
GOTO EXIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+7 SET ZTRTN="TASK^MCPOS02A"
+8 SET ZTSAVE("^TMP(""MCPOS02"",$J,")=""
+9 SET ZTDESC="Medicine New Person Conversion Exception Report"
+10 SET ZTDTH=$HOROLOG
+11 DO ^%ZTLOAD
+12 QUIT
End DoDot:1
GOTO EXIT
TASK ;
+1 SET (MCEXIT,MCFOUND)=0
SET MCPAGE=1
SET MCTODAY=$$FMTE^XLFDT($$DT^XLFDT)
+2 KILL MCUNDL
SET $PIECE(MCUNDL,"=",81)=""
+3 USE IO
DO HEADER
+4 SET MCFILE=0
+5 FOR
SET MCFILE=$ORDER(^TMP("MCPOS02",$JOB,MCFILE))
if MCFILE'>0!MCEXIT
QUIT
Begin DoDot:1
+6 IF $PIECE(^TMP("MCPOS02",$JOB,MCFILE),U,2)'>0
QUIT
+7 WRITE !!,MCFILE
+8 SET MCFLD=0
+9 FOR
SET MCFLD=$ORDER(^TMP("MCPOS02",$JOB,MCFILE,MCFLD))
if MCFLD'>0!MCEXIT
QUIT
Begin DoDot:2
+10 IF $PIECE(^TMP("MCPOS02",$JOB,MCFILE,MCFLD),U,2)'>0
QUIT
+11 WRITE ?8,MCFLD
+12 SET MCD0=0
+13 FOR
SET MCD0=$ORDER(^TMP("MCPOS02",$JOB,MCFILE,MCFLD,MCD0))
if MCD0'>0!MCEXIT
QUIT
Begin DoDot:3
+14 SET MCDATA=^TMP("MCPOS02",$JOB,MCFILE,MCFLD,MCD0)
+15 SET X=$PIECE(MCDATA,U)
SET MC6=$PIECE(X,";")
SET MC6(0)=$PIECE(X,";",2)
+16 SET X=$PIECE(MCDATA,U,2)
SET MC16=$PIECE(X,";")
SET MC16(0)=$PIECE(X,";",2)
+17 SET X=$PIECE(MCDATA,U,3)
SET MC200=$PIECE(X,";")
SET MC200(0)=$PIECE(X,";",2)
+18 SET MCERROR=$PIECE(MCDATA,U,4)
+19 DO PRINT
+20 QUIT
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 IF 'MCFOUND
WRITE !!,"No exceptions found."
+24 ;
EXIT ;
+1 DO ^%ZISC
+2 IF '$DATA(XPDNM)
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL %ZIS,DIR,DIRUT,DTOUT,DUOUT,MC16,MC200,MC6,MCD0,MCDATA,MCERROR,MCEXIT
+4 KILL MCFILE,MCFLD,MCFOUND,MCPAGE,MCTODAY,MCUNDL,POP,X,Y,ZTDESC,ZTRTN
+5 KILL ^TMP("MCPOS02",$JOB)
+6 QUIT
+7 ;
PRINT ;
+1 WRITE ?14,MCD0
+2 WRITE ?25,MC6,?36,MC16,?47,MC200,?58,MCERROR
+3 WRITE !?15,MC6(0),?50,MC16(0),!!
+4 IF $Y>(IOSL-6)
DO PAUSE
DO HEADER
+5 SET MCFOUND=1
+6 QUIT
PAUSE ;
+1 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+2 NEW DIR
SET DIR(0)="E"
DO ^DIR
SET MCEXIT=$SELECT(Y'>0:1,1:0)
+3 QUIT
End DoDot:1
+4 QUIT
+5 ;
+1 IF MCEXIT
QUIT
+2 if ($EXTRACT(IOST,1,2)="C-")!(MCPAGE>1)
WRITE @IOF
+3 WRITE !?21,"Medicine New Person Exception Report",?68,MCTODAY
+4 WRITE !?68,"Page: ",MCPAGE
SET MCPAGE=MCPAGE+1
+5 WRITE !,"File",?8,"Field",?14,"IEN"
+6 WRITE ?25,"P==>6",?36,"P==>16",?47,"P==>200",?58,"Error Message"
+7 WRITE !?15,"Provider Name",?50,"Person Name",!,MCUNDL,!
+8 QUIT
