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

IBENDS1.m

Go to the documentation of this file. 
  1. IBENDS1 ;DAL/JCH - NDS PAYERS MTOP UTILITIES ;15-JUN-2017
  1.  ;;2.0;INTEGRATED BILLING;**585**;21-MAR-94;Build 68
  1.  ;
  1.  ; Type of Plan (#355.1) to Master Type of Plan (#355.99) associations
  1.  ; Available at Master Type of Plan Report [IBMTOP RPT] option, at the following menu path:
  1.  ;    Billing Supervisor Menu [IB BILLING SUPERVISOR MENU]
  1.  ;      MCCR System Definition Menu [MCCR SYSTEM DEFINITION MENU]
  1.  ;        Master Type of Plan Menu [IBMTOP MNU]
  1.  ;          Master Type of Plan Report [IBMTOP RPT]
  1.  Q
  1.  ;
  1. EN ; MTOP Report Entry point
  1.  N IBEOUT,IBEION
  1.  S IBEOUT=0
  1.  F  Q:$G(IBEOUT)  D
  1.  .D MAIN Q:IBEOUT
  1.  .N DIR W !!
  1.  .S DIR(0)="Y",DIR("B")="Y",DIR("A")="Run report again" D ^DIR
  1.  .S:X'="Y" IBEOUT=1
  1.  Q
  1.  ;
  1. MAIN ; Driver loop
  1.  N IBESUM,IBEMUA,IBESTOP,IBEOUTP
  1.  S IBESTOP=0
  1.  ;
  1.  D CLEAR^VALM1
  1.  ;
  1.  W !!?2,"This report will print Plan Types from the TYPE OF PLAN"
  1.  W !?2,"(#355.1) file and each Plan Type's mapping relationship"
  1.  W !?2,"to the Public Health Data Standards Consortium (PHDSC)"
  1.  w !?2,"Source of Payment in the MASTER TYPE OF PLAN (#355.99) file."
  1.  ;
  1.  ; Select (M)apped, (U)nmapped, or (A)ll entries from TYPE OF PLAN (#355.1) file.
  1.  W ! D MUA(.IBEMUA) I '$D(IBEMUA)!$G(IBEOUT) S IBEOUT=1 Q
  1.  ;
  1.  ; Select summary report or detailed
  1.  S IBESUM=$$SUMMARY I 'IBESUM Q
  1.  ;
  1.  ; Select output format
  1.  S IBEOUTP=$$OUT I IBESTOP Q
  1.  ;
  1.  ; Select device
  1.  I $$SELDEV()!IBESTOP Q
  1.  ;
  1.  I IBEOUTP="R" W !!,"<*> please wait <*>"
  1.  U IO D DQ
  1.  ;
  1.  Q
  1.  ;
  1. DQ ;  report (queue) starts here
  1.  N IBETOPI,IBEMTOPI,IBETOP0,IBEMTOP0,IBENAME
  1.  ;
  1.  K ^TMP($J,"IBENDS1")
  1.  ;  build list of plan types
  1.  S IBETOPI=0 F  S IBETOPI=$O(^IBE(355.1,IBETOPI)) Q:'IBETOPI  D
  1.  .S IBETOP0=$G(^IBE(355.1,IBETOPI,0)),IBEMTOPI=$P(IBETOP0,"^",5)
  1.  .I $G(IBEMUA)="U",$G(IBEMTOPI) Q
  1.  .I $G(IBEMUA)="M",'$G(IBEMTOPI) Q
  1.  .S IBEMTOP0=$S($G(IBEMTOPI):$G(^IBEMTOP(355.99,+IBEMTOPI,0)),1:"Not Mapped")
  1.  .I IBEMTOPI S $P(IBEMTOP0,"^",4)=IBEMTOPI
  1.  .S IBENAME=$P(IBETOP0,"^")
  1.  .S ^TMP($J,"IBENDS1",IBENAME,IBETOPI,"TOP")=$G(IBETOP0)
  1.  .S ^TMP($J,"IBENDS1",IBENAME,IBETOPI,"MTOP")=$G(IBEMTOP0)
  1.  ;
  1.  D PRINT
  1.  ;
  1.  D ^%ZISC
  1.  K ^TMP($J,"IBENDS1")
  1.  Q
  1.  ;
  1. PRINT ; Print output
  1.  N MAXCNT,IBESTOP,IBEPGCNT,IBEHDR,CRT,IBCNT
  1.  I IOST["C-" S MAXCNT=IOSL-10,CRT=1
  1.  E  S MAXCNT=IOSL-6,CRT=0
  1.  I IBESUM=1 S MAXCNT=MAXCNT+5
  1.  S IBEPGCNT=0,IBESTOP=0
  1.  ;
  1.  I '$D(^TMP($J,"IBENDS1")) D HEADER W !!!?5,"No Data Found" Q
  1.  ;
  1.  N IBETOPI,IBENAME
  1.  S IBENAME="" F IBCNT=1:1 S IBENAME=$O(^TMP($J,"IBENDS1",IBENAME)) Q:IBENAME=""!IBESTOP  D
  1.  .S IBETOPI=0 F  S IBETOPI=$O(^TMP($J,"IBENDS1",IBENAME,IBETOPI)) Q:'IBETOPI!IBESTOP  D
  1.  ..D PRINT2(IBENAME,IBETOPI)
  1.  Q
  1.  ;
  1. PRINT2(IBENAME,IBETOPI)  ; Continue printing output
  1.  N IBETOP0,IBEMTOP0,IBECT,IBECTS,IBECTX,IBTOPST
  1.  N IBEMTST,IBEMTED,IBEMTOPI,IBEMTEDI,IBEMPAR,IBEMPARX
  1.  N IBEMREPL,IBEMREPX,IBEMV0
  1.  ;
  1.  I $G(IBEOUTP)="E" D DELIM(IBENAME,IBETOPI) Q
  1.  ;
  1.  I ($Y+1>MAXCNT)!'IBEPGCNT D HEADER Q:IBESTOP
  1.  S IBETOP0=$G(^TMP($J,"IBENDS1",IBENAME,IBETOPI,"TOP"))
  1.  S IBTOPST=$P(IBETOP0,"^",4),IBTOPST=$S(IBTOPST:"INACTIVE",1:"ACTIVE")
  1.  D PRINTOP(IBENAME,IBETOPI)
  1.  ;
  1.  Q:'IBEMTOPI
  1.  I $G(IBESUM)=2 D
  1.  .S IBEMTED=$$NOW^XLFDT,IBEMTED=$O(^IBEMTOP(355.99,IBEMTOPI,"TERMSTATUS","B",IBEMTED),-1)
  1.  .I IBEMTED D  ; This should always be true, if data came from STS MFS process
  1.  ..S IBEMTEDI="",IBEMTEDI=$O(^IBEMTOP(355.99,IBEMTOPI,"TERMSTATUS","B",IBEMTED,IBEMTEDI))
  1.  ..S IBEMTST=$P(^IBEMTOP(355.99,IBEMTOPI,"TERMSTATUS",IBEMTEDI,0),"^",2)
  1.  ..W ?22,"  PHDSC Status: ",$S(IBEMTST:"ACTIVE",1:"INACTIVE")
  1.  .S IBEMPAR=$P(IBEMTOP0,"^",3) I IBEMPAR S IBEMPARX=$P($G(^IBEMTOP(355.99,IBEMPAR,0)),"^")
  1.  .I $L($G(IBEMPARX)) W !,"PHDSC Parent: ",IBEMPARX
  1.  .S IBEMV0=$G(^IBEMTOP(355.99,IBEMTOPI,"VUID"))
  1.  .S IBEMREPL=$P(IBEMV0,"^",3) I IBEMREPL S IBEMREPX=$P($G(^IBEMTOP(355.99,IBEMREPL,0)),"^")
  1.  .I $L($G(IBEMREPX)) W !,"MTOP PHDSC Replaced By: ",IBEMREPX
  1.  Q
  1.  ;
  1. MUA(IBEMUA) ; Select (M)apped, (U)nmapped, or(A)ll - entries from 355.1 mapped to 355.99
  1.  N DIR,DIRUT,Y
  1.  W ! S DIR(0)="SAO^M:(M)apped;U:(U)nmapped;A:(A)ll"
  1.  S DIR("?")="Enter ^ to exit"
  1.  S DIR("A",1)="Run the report for"
  1.  S DIR("A")="(M)apped, (U)nmapped, or (A)ll Type of Plan entries: ",DIR("B")="A" D ^DIR
  1.  I $D(DIRUT) S IBEOUT=1 Q
  1.  S IBEMUA=Y
  1.  Q
  1.  ;
  1. SUMMARY() ;  ask to print detailed or summary report
  1.  N DIR,DIRUT,X,Y
  1.  S DIR(0)="SOA^D:Detailed;S:Summary;",DIR("B")="Summary"
  1.  S DIR("A")="Type of report to print: "
  1.  W ! D ^DIR
  1.  I $D(DIRUT) S IBESTOP=1 Q 0
  1.  Q $S(Y="S":1,Y="D":2,1:0)
  1.  ;
  1. OUT() ; select Excel or Report format
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="SA^E:Excel;R:Report"
  1.  S DIR("A")="(E)xcel Format or (R)eport Format: "
  1.  S DIR("B")="Report"
  1.  D ^DIR I $D(DIRUT) S IBESTOP=1 Q ""
  1.  Q Y
  1.  ;
  1. DELIM(IBENAME,IBETOPI)  ; Print output in "^" delimited format
  1.  ; Print data in (E)xcel format, e.g., "data^data^data"
  1.  N IBSTRING,IBABB,IBCATX,IBTOPST
  1.  N IBMCOD,IBMNAM,IBMSTAT,IBMAP
  1.  I IBCNT=1 D
  1.  .I IBESUM=2 W !,"TYPE OF PLAN NAME^PLAN ABBREVIATION^PLAN STATUS^MAJOR CATEGORY^MAPPED/NOT MAPPED^MTOP PHDSC NAME^MTOP PHDSC CODE^MTOP PHDSC STATUS^PARENT^REPLACED BY"
  1.  .I IBESUM=1 W !,"TYPE OF PLAN NAME^MAPPED/NOT MAPPED^MTOP PHDSC NAME"
  1.  S IBETOP0=$G(^TMP($J,"IBENDS1",IBENAME,IBETOPI,"TOP"))
  1.  S IBTOPST=$P(IBETOP0,"^",4),IBTOPST=$S(IBTOPST:"INACTIVE",1:"ACTIVE")
  1.  S IBABB=$P(IBETOP0,"^",2)
  1.  S IBECT=$P(IBETOP0,"^",3) D
  1.  .N IBECTS,IBERR
  1.  .S IBCATX=""
  1.  .D FIND^DIC(355.1,,".01;.03","A","`"_+$G(IBETOPI),,,,,"IBECTS","IBERR")
  1.  .I $G(IBENAME)=$G(IBECTS("DILIST","ID",1,.01)) S IBCATX=$G(IBECTS("DILIST","ID",1,.03))
  1.  S IBEMTOP0=$G(^TMP($J,"IBENDS1",IBENAME,IBETOPI,"MTOP"))
  1.  S IBEMTOPI=+$P(IBEMTOP0,"^",4)
  1.  S IBMNAM=$P(IBEMTOP0,"^"),IBMCOD=$P(IBEMTOP0,"^",2)
  1.  S IBMAP=$S(IBEMTOPI:"MAPPED",1:"NOT MAPPED")
  1.  I 'IBEMTOPI D  Q
  1.  .I IBESUM=2 S IBSTRING=IBENAME_"^"_IBABB_"^"_IBTOPST_"^"_IBCATX_"^"_IBMAP
  1.  .I IBESUM'=2 S IBSTRING=IBENAME_"^"_IBMAP
  1.  .W !,IBSTRING
  1.  S IBEMTED=$$NOW^XLFDT,IBEMTED=$O(^IBEMTOP(355.99,IBEMTOPI,"TERMSTATUS","B",IBEMTED),-1)
  1.  S IBEMTEDI="",IBEMTEDI=$O(^IBEMTOP(355.99,IBEMTOPI,"TERMSTATUS","B",IBEMTED,IBEMTEDI))
  1.  S IBEMTST=$P(^IBEMTOP(355.99,IBEMTOPI,"TERMSTATUS",IBEMTEDI,0),"^",2)
  1.  S IBMSTAT=$S(IBEMTST:"ACTIVE",1:"INACTIVE")
  1.  S IBEMPAR=+$P(IBEMTOP0,"^",3)
  1.  S IBEMPARX=$P($G(^IBEMTOP(355.99,IBEMPAR,0)),"^")
  1.  S IBEMV0=$G(^IBEMTOP(355.99,IBEMTOPI,"VUID"))
  1.  S IBEMREPL=+$P(IBEMV0,"^",3)
  1.  S IBEMREPX=$P($G(^IBEMTOP(355.99,IBEMREPL,0)),"^")
  1.  I IBESUM=2 S IBSTRING=IBENAME_"^"_IBABB_"^"_IBTOPST_"^"_IBCATX_"^"_IBMAP_"^"_IBMNAM_"^"_IBMCOD_"^"_IBMSTAT_"^"_IBEMPARX_"^"_IBEMREPX
  1.  I IBESUM'=2 S IBSTRING=IBENAME_"^"_IBMAP_"^"_IBMNAM
  1.  W !,IBSTRING
  1.  Q
  1.  ;
  1. SELDEV()  ; Prompt for output device, return 1 if queued
  1.  I IBEOUTP="E" D
  1.  .N DIR,X,Y
  1.  .S DIR("A",1)=""
  1.  .S DIR("A",2)="     ************************************************************"
  1.  .S DIR("A",3)="     **  You selected a Delimited report. Please verify you    **"
  1.  .S DIR("A",4)="     **  you have turned logging on to capture the output.     **"
  1.  .S DIR("A",5)="     **                                                        **"
  1.  .S DIR("A",6)="     **  To avoid undesired wrapping, enter '0;199;999' at     **"
  1.  .S DIR("A",7)="     **  the 'DEVICE:' prompt. The Terminal Session display    **"
  1.  .S DIR("A",8)="     **  may need to be set to 199 columns.                    **"
  1.  .S DIR("A",9)="     ************************************************************"
  1.  .S DIR("A",10)=""
  1.  .S DIR("A",11)="",DIR("A",12)=""
  1.  .S DIR("A")=" Press return to continue"
  1.  .S DIR(0)="EA" D ^DIR W !
  1.  ;
  1.  N IBEDONE
  1.  W !,"You may queue this report to print at a later time.",!
  1.  F  Q:$G(IBESTOP)!$G(IBEDONE)  D
  1.  .K %ZIS,IOP,POP,ZTSK N I S IBEION=$I,%ZIS="QM"
  1.  .D ^%ZIS K %ZIS
  1.  .I POP S IOP=IBEION D ^%ZIS K IOP,IBEION D  Q
  1.  ..N DIR,X,Y
  1.  ..S DIR(0)="YA",DIR("A",1)="  ** No Device Selected **",DIR("A")="Select a different device? (Y/N) " D ^DIR
  1.  ..S:'Y IBESTOP=1
  1.  .S IBEDONE=1
  1.  I $D(IO("Q")) D  Q 1
  1.  .N ZTDESC,ZTSAVE,ZTRTN
  1.  .S ZTDESC="Type of Plan to MTOP Mapping Report",ZTRTN="DQ^IBENDS1"
  1.  .S ZTSAVE("DATE*")="",ZTSAVE("IBE*")="",ZTSAVE("ZTREQ")="@"
  1.  .K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print!" K ZTSK
  1.  Q:$G(IBESTOP) -1
  1.  Q 0
  1.  ;
  1.  N IBEHDR,IBETAB,IBESPACE
  1.  S IBESTOP=0
  1.  I CRT,IBEPGCNT>0,'$D(ZTQUEUED) D  Q:IBESTOP
  1.  .N DIR,LIN
  1.  .I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1.  .W !
  1.  .S DIR(0)="E" D ^DIR K DIR
  1.  .I 'Y S IBESTOP=1 Q
  1.  S IBEPGCNT=IBEPGCNT+1
  1.  W @IOF,!
  1.  S $P(IBESPACE," ",132)=""
  1.  S IBEHDR=" Type Of Plan Map to Master Type of Plan (MTOP)    "
  1.  S IBEHDR(1)="    PHDSC Source of Payment Typology Report"
  1.  S IBEHDR=IBEHDR_"Page: "_IBEPGCNT,IBETAB=132-$L(IBEHDR)-1
  1.  W IBEHDR
  1.  W !,IBEHDR(1)
  1.  Q
  1.  ;
  1. PRINTOP(IBENAME,IBETOPI)  ; Print Type of Plan file (#355.1) entry
  1.  W !!,"Type of Plan: ",$P(IBETOP0,"^")
  1.  I $G(IBESUM)=2 D
  1.  .W !,"Abbreviation: ",$P(IBETOP0,"^",2)
  1.  .W ?30,"Status: ",IBTOPST
  1.  .S IBECT=$P(IBETOP0,"^",3) I $L(IBECT) D
  1.  ..D FIELD^DID(355.1,.03,"","POINTER","IBECTS")
  1.  ..S IBECTX=$P(IBECTS("POINTER"),+IBECT_":",2),IBECTX=$P(IBECTX,";")
  1.  ..I $L(IBECTX) W !?4,"Category: ",IBECTX
  1.  S IBEMTOP0=$G(^TMP($J,"IBENDS1",IBENAME,IBETOPI,"MTOP"))
  1.  S IBEMTOPI=+$P(IBEMTOP0,"^",4)
  1.  W !?2,"Mapped to PHDSC Source of Payment?: ",$S(IBEMTOPI:"YES",1:"NO")
  1.  Q:'IBEMTOPI
  1.  W !?2,"PHDSC Name: ",$P(^TMP($J,"IBENDS1",IBENAME,IBETOPI,"MTOP"),"^")
  1.  W !?2,"PHDSC Code: ",$P(^TMP($J,"IBENDS1",IBENAME,IBETOPI,"MTOP"),"^",2)
  1.  Q