IBENDS ;DAL/JCH - NDS PAYERS MTOP UTILITIES ;15-JUN-2017
;;2.0;INTEGRATED BILLING;**585**;21-MAR-94;Build 68
;
Q
;
; Available at Master Type of Plan Association [IBMTOP ASSN] option, at the following menu path:
; Billing Supervisor Menu [IB BILLING SUPERVISOR MENU]
; MCCR System Definition Menu [MCCR SYSTEM DEFINITION MENU]
; Master Type of Plan Menu [IBMTOP MNU]
; Master Type of Plan Association [IBMTOP ASSN]
;
EN ; Allow users to populate the MASTER TYPE OF PLAN field (#15) in TYPE OF PLAN file (#355.1)
D INFO,KILLTMP ; Display option info, kill ^TMP($J,"IBENDS1"
N IBDONE ; Signal from user - Q:IBDONE
N IBENAME ; TOP Name
S IBDONE=0
; Prompt for TYPE OF PLAN (#355.1) entries until user quits
F Q:IBDONE D
.N DIE,DA,DR,DIC,X,Y,DIR,DUOUT,IBETOPY,IBETOPI,IBTOPNAM,IBETOP0,IBEMTOP0,IBEMTOPI,IBESUM,IBEMISV
.;
.; Prompt for TOP
.S IBETOPI=+$$GETOP(.IBTOPNAM,.IBDONE) Q:$G(IBDONE)
.;
.; Get relevant info from 355.1 and 355.9, store in ^TMP($J
.D GETDATA($G(IBTOPNAM),IBETOPI)
.S IBENAME=$P(IBETOP0,"^")
.S IBEMISV=$G(IBEMTOPI) ; Save associated master IEN, so we can check later if it's changed
.;
.; display Type of Plan record details, prompt for new MTOP pointer in TOP file
.S IBESUM=2 D PRINTOP^IBENDS1(IBENAME,IBETOPI)
.D UPDMTOP(IBETOPI) Q:$G(DUOUT)!$G(DTOUT)
.D GETDATA($G(IBTOPNAM),IBETOPI) ; Get updated TOP (#355.1) details
.;
.I $G(IBEMTOPI)'=$G(IBEMISV) D ; MTOP pointer changed, re-display updated info
..D REDISP(IBENAME,IBETOPI)
.;
.S DIR(0)="EA",DIR("A",1)="",DIR("A",2)="",DIR("A")="Press Return to continue "
.D ^DIR
.D INFO
D KILLTMP
Q
;
INFO ; Display message, clear screen
N MSG
S MSG(1)=" This option allows VA TYPE OF PLAN file entries to be associated with"
S MSG(2)=" MASTER TYPE OF PLAN file entries to enhance interoperability. MASTER"
S MSG(3)=" TYPE OF PLAN file entries represent the Source of Payment Typology"
S MSG(4)=" developed by the Public Health Data Standards Consortium (PHDSC)."
S MSG(5)=""
D CLEAR^VALM1
D BMES^XPDUTL(.MSG)
Q
;
GETOP(IBTOPNAM,IBDONE) ; Prompt for Type of Plan
N DIC
S DIC=355.1
S DIC(0)="QEAMZ"
W ! D ^DIC I Y<0 S IBDONE=1,Y=""
S IBTOPNAM=$P(Y,"^",2)
Q +Y
;
UPDMTOP(IBMTOPI) ; Update Master Type of Plan field (#90) in TOP file (#355.1)
; Use IB TOPM input template to restrict input to MTOP field
N DIE,DR,DA
S DIE="^IBE(355.1,"
S DR="[IB TOPM]"
S DA=IBETOPI
D ^DIE
Q
;
GETDATA(IBENAME,IBETOPI) ; Define local variables and set into ^TMP($J
S IBETOP0=$G(^IBE(355.1,IBETOPI,0)),IBEMTOPI=$P(IBETOP0,"^",5)
S IBTOPST=$P(IBETOP0,"^",4),IBTOPST=$S(IBTOPST:"INACTIVE",1:"ACTIVE")
S IBEMTOP0=$S($G(IBEMTOPI):$G(^IBEMTOP(355.99,+IBEMTOPI,0)),1:"Not Mapped")
I IBEMTOPI S $P(IBEMTOP0,"^",4)=IBEMTOPI
S ^TMP($J,"IBENDS1",IBENAME,IBETOPI,"TOP")=$G(IBETOP0)
S ^TMP($J,"IBENDS1",IBENAME,IBETOPI,"MTOP")=$G(IBEMTOP0)
Q
;
REDISP(IBENAME,IBETOPI) ; Redisplay updated Type of Plan (#355.1) entry
W !!,"Update Successful...."
S IBESUM=1 D PRINTOP^IBENDS1(IBENAME,IBETOPI) ; display summarized TOP entry info
Q
;
KILLTMP ; Kill ^TMP global
K ^TMP($J,"IBENDS1")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBENDS 3257 printed Apr 09, 2024@21:10:48 Page 2
IBENDS ;DAL/JCH - NDS PAYERS MTOP UTILITIES ;15-JUN-2017
+1 ;;2.0;INTEGRATED BILLING;**585**;21-MAR-94;Build 68
+2 ;
+3 QUIT
+4 ;
+5 ; Available at Master Type of Plan Association [IBMTOP ASSN] option, at the following menu path:
+6 ; Billing Supervisor Menu [IB BILLING SUPERVISOR MENU]
+7 ; MCCR System Definition Menu [MCCR SYSTEM DEFINITION MENU]
+8 ; Master Type of Plan Menu [IBMTOP MNU]
+9 ; Master Type of Plan Association [IBMTOP ASSN]
+10 ;
EN ; Allow users to populate the MASTER TYPE OF PLAN field (#15) in TYPE OF PLAN file (#355.1)
+1 ; Display option info, kill ^TMP($J,"IBENDS1"
DO INFO
DO KILLTMP
+2 ; Signal from user - Q:IBDONE
NEW IBDONE
+3 ; TOP Name
NEW IBENAME
+4 SET IBDONE=0
+5 ; Prompt for TYPE OF PLAN (#355.1) entries until user quits
+6 FOR
if IBDONE
QUIT
Begin DoDot:1
+7 NEW DIE,DA,DR,DIC,X,Y,DIR,DUOUT,IBETOPY,IBETOPI,IBTOPNAM,IBETOP0,IBEMTOP0,IBEMTOPI,IBESUM,IBEMISV
+8 ;
+9 ; Prompt for TOP
+10 SET IBETOPI=+$$GETOP(.IBTOPNAM,.IBDONE)
if $GET(IBDONE)
QUIT
+11 ;
+12 ; Get relevant info from 355.1 and 355.9, store in ^TMP($J
+13 DO GETDATA($GET(IBTOPNAM),IBETOPI)
+14 SET IBENAME=$PIECE(IBETOP0,"^")
+15 ; Save associated master IEN, so we can check later if it's changed
SET IBEMISV=$GET(IBEMTOPI)
+16 ;
+17 ; display Type of Plan record details, prompt for new MTOP pointer in TOP file
+18 SET IBESUM=2
DO PRINTOP^IBENDS1(IBENAME,IBETOPI)
+19 DO UPDMTOP(IBETOPI)
if $GET(DUOUT)!$GET(DTOUT)
QUIT
+20 ; Get updated TOP (#355.1) details
DO GETDATA($GET(IBTOPNAM),IBETOPI)
+21 ;
+22 ; MTOP pointer changed, re-display updated info
IF $GET(IBEMTOPI)'=$GET(IBEMISV)
Begin DoDot:2
+23 DO REDISP(IBENAME,IBETOPI)
End DoDot:2
+24 ;
+25 SET DIR(0)="EA"
SET DIR("A",1)=""
SET DIR("A",2)=""
SET DIR("A")="Press Return to continue "
+26 DO ^DIR
+27 DO INFO
End DoDot:1
+28 DO KILLTMP
+29 QUIT
+30 ;
INFO ; Display message, clear screen
+1 NEW MSG
+2 SET MSG(1)=" This option allows VA TYPE OF PLAN file entries to be associated with"
+3 SET MSG(2)=" MASTER TYPE OF PLAN file entries to enhance interoperability. MASTER"
+4 SET MSG(3)=" TYPE OF PLAN file entries represent the Source of Payment Typology"
+5 SET MSG(4)=" developed by the Public Health Data Standards Consortium (PHDSC)."
+6 SET MSG(5)=""
+7 DO CLEAR^VALM1
+8 DO BMES^XPDUTL(.MSG)
+9 QUIT
+10 ;
GETOP(IBTOPNAM,IBDONE) ; Prompt for Type of Plan
+1 NEW DIC
+2 SET DIC=355.1
+3 SET DIC(0)="QEAMZ"
+4 WRITE !
DO ^DIC
IF Y<0
SET IBDONE=1
SET Y=""
+5 SET IBTOPNAM=$PIECE(Y,"^",2)
+6 QUIT +Y
+7 ;
UPDMTOP(IBMTOPI) ; Update Master Type of Plan field (#90) in TOP file (#355.1)
+1 ; Use IB TOPM input template to restrict input to MTOP field
+2 NEW DIE,DR,DA
+3 SET DIE="^IBE(355.1,"
+4 SET DR="[IB TOPM]"
+5 SET DA=IBETOPI
+6 DO ^DIE
+7 QUIT
+8 ;
GETDATA(IBENAME,IBETOPI) ; Define local variables and set into ^TMP($J
+1 SET IBETOP0=$GET(^IBE(355.1,IBETOPI,0))
SET IBEMTOPI=$PIECE(IBETOP0,"^",5)
+2 SET IBTOPST=$PIECE(IBETOP0,"^",4)
SET IBTOPST=$SELECT(IBTOPST:"INACTIVE",1:"ACTIVE")
+3 SET IBEMTOP0=$SELECT($GET(IBEMTOPI):$GET(^IBEMTOP(355.99,+IBEMTOPI,0)),1:"Not Mapped")
+4 IF IBEMTOPI
SET $PIECE(IBEMTOP0,"^",4)=IBEMTOPI
+5 SET ^TMP($JOB,"IBENDS1",IBENAME,IBETOPI,"TOP")=$GET(IBETOP0)
+6 SET ^TMP($JOB,"IBENDS1",IBENAME,IBETOPI,"MTOP")=$GET(IBEMTOP0)
+7 QUIT
+8 ;
REDISP(IBENAME,IBETOPI) ; Redisplay updated Type of Plan (#355.1) entry
+1 WRITE !!,"Update Successful...."
+2 ; display summarized TOP entry info
SET IBESUM=1
DO PRINTOP^IBENDS1(IBENAME,IBETOPI)
+3 QUIT
+4 ;
KILLTMP ; Kill ^TMP global
+1 KILL ^TMP($JOB,"IBENDS1")
+2 QUIT
