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

IBCNRPSM.m

Go to the documentation of this file.
  1. IBCNRPSM ;DAOU/CMW - Match Test Payer Sheet to a Pharmacy Plan ;10-DEC-2003
  1. ;;2.0;INTEGRATED BILLING;**251,435**;21-MAR-94;Build 27
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. EN(IBCNSP) ; Main entry point for IBCNR PAYERSHEET MATCH (LIST TEMPLATE)
  1. D EN^VALM("IBCNR PAYERSHEET MATCH")
  1. Q
  1. ;
  1. HDR ; Header code
  1. N IBCNS0,IBCNSID,IBCNSNM,IBCNS10,IBCNSPBM,IBCNSBIN,IBCNSPCN,IBCNS3
  1. N IBCNSNST,IBCNSLST,IBCNSHDR,X
  1. S IBCNS0=$G(^IBCNR(366.03,+IBCNSP,0))
  1. S IBCNSID=$P(IBCNS0,"^",1) ;id
  1. S IBCNSNM=$P(IBCNS0,"^",2) ;name
  1. S IBCNS10=$G(^IBCNR(366.03,+IBCNSP,10))
  1. S IBCNSPBM=$P(IBCNS10,"^",1) ;pbm
  1. I IBCNSPBM S IBCNSPBM=$P($G(^IBCNR(366.02,+IBCNSPBM,0)),"^",1) ; pbm name
  1. S IBCNSBIN=$P(IBCNS10,"^",2) ;bin
  1. S IBCNSPCN=$P(IBCNS10,"^",3) ;pcn
  1. S IBCNS3=$G(^IBCNR(366.03,+IBCNSP,3,1,0)) ; appl
  1. S IBCNSNST=$S($P(IBCNS3,"^",2)=0:"Inactive",1:"Active")
  1. S IBCNSLST=$S($P(IBCNS3,"^",3)=0:"Inactive",1:"Active")
  1. ; Header Line 1
  1. S IBCNSHDR="PLAN: "
  1. S X=IBCNSID_" - "_IBCNSNM
  1. S VALMHDR(1)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80)
  1. ; Header Line 2
  1. S IBCNSHDR="PBM: "_IBCNSPBM
  1. S X=" BIN: "_IBCNSBIN_" PCN: "_IBCNSPCN
  1. S VALMHDR(2)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80)
  1. ; Header Line 3
  1. S IBCNSHDR="STATUS: "
  1. S X="National "_IBCNSNST_"/Local "_IBCNSLST
  1. S VALMHDR(3)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80)
  1. Q
  1. ;
  1. INIT ; Init variables and list array
  1. N TCODE,IBCNS10,I,TPS,X,NUMBER,PSN
  1. K ^TMP("IBCNR",$J),TCODE
  1. S VALMCNT=0,VALMBG=1
  1. S TCODE(1)="BILLING (B1)"
  1. S TCODE(2)="REVERSAL (B2)"
  1. S TCODE(3)="REBILL (B3)"
  1. S TCODE(4)="ELIGIBILITY (E1)"
  1. S IBCNS10=$G(^IBCNR(366.03,IBCNSP,10))
  1. F I=1:1:4 S TPS=$P(IBCNS10,"^",10+I) D
  1. . ; Set up Index Number
  1. . S VALMCNT=I
  1. . S X=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
  1. . ; Set up Transaction code
  1. . S X=$$SETFLD^VALM1(TCODE(I),X,"TCODE")
  1. . ; Set up the payer sheet name
  1. . I $G(TPS) S PSN=$G(^BPSF(9002313.92,TPS,0))
  1. . I '$G(TPS) S PSN="NOT FOUND"
  1. . S X=$$SETFLD^VALM1(PSN,X,"PSHEET")
  1. . ; Set up temporary array
  1. . S ^TMP("IBCNR",$J,VALMCNT,0)=X
  1. . S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT)=IBCNSP
  1. Q
  1. ;
  1. HELP ; Help code
  1. I $D(X),X'["??" D
  1. . W !,"Possible actions are the following:"
  1. . S X="?" D DISP^XQORM1,PAUSE^VALM1
  1. Q
  1. ;
  1. EXIT ; Exit code
  1. K ^TMP("IBCNR",$J),VALMY
  1. D CLEAN^VALM10
  1. Q
  1. ;
  1. EXPND ; Expand code
  1. Q
  1. ;
  1. SEL ; Add Payer Sheet to Plan
  1. ; Get the transaction code
  1. N IBX,IBSEL,IBDR
  1. D S1
  1. I 'IBX Q
  1. ; Get the Payer Sheet Name
  1. N DIC,Y,X,DTOUT,DUOUT
  1. N DA,DIE,DR
  1. S DIC="^BPSF(9002313.92,",DIC(0)="AEMZ",DIC("S")="I $P(^(1),U,6)=2"
  1. S DIC("B")=$$GET1^DIQ(366.03,IBSEL,IBDR)
  1. D ^DIC
  1. I +Y<1 W !!,"No Payer Sheet Selected!" D PAUSE^VALM1 Q
  1. ; Do the insert
  1. S DA=IBSEL,DIE="^IBCNR(366.03,",DR=IBDR_"////^S X="_+Y
  1. D ^DIE
  1. ; Rebuild ListMan screen data
  1. D INIT
  1. Q
  1. ;
  1. DEL ; Delete Payer Sheet from Plan
  1. ; Get the transaction code
  1. N IBX,IBSEL,IBDR
  1. D S1
  1. I 'IBX Q
  1. ; Do the deletion
  1. N DA,DIE,DR
  1. S DA=IBSEL,DIE="^IBCNR(366.03,",DR=IBDR_"///@"
  1. D ^DIE
  1. ; Rebuild ListMan screen data
  1. D INIT
  1. Q
  1. ;
  1. S1 ; Prompt for transaction code
  1. N VALMY
  1. D FULL^VALM1,EN^VALM2($G(XQORNOD(0)),"S")
  1. ; Store transaction code in IBX
  1. S IBX=$O(VALMY(0))
  1. ; Set variable to refresh the screen when returning from the action
  1. S VALMBCK="R"
  1. ; Display error if not transaction code was picked and exit
  1. I 'IBX W !!,"No Transaction Code Selected!" D PAUSE^VALM1 Q
  1. ; Build variables needed for insert or deletion
  1. S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX))
  1. S IBDR=$S(IBX=1:10.11,IBX=2:10.12,IBX=3:10.13,1:10.14)
  1. Q