- 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 Jan 18, 2025@03:17:34 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