| 1 | IBJPS ;ALB/MAF,ARH - IBSP IB SITE PARAMETER SCREEN ;22-DEC-1995
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**39,52,70,115,143,51,137,161,155,320,348,349**;21-MAR-94;Build 46
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; -- main entry point for IBJP IB SITE PARAMETERS, display IB site parameters
|
|---|
| 6 | D EN^VALM("IBJP IB SITE PARAMETERS")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | HDR ; -- header code
|
|---|
| 10 | S VALMHDR(1)="Only authorized persons may edit this data."
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | INIT ; -- init variables and list array
|
|---|
| 14 | K ^TMP("IBJPS",$J),^TMP("IBJPSAX",$J)
|
|---|
| 15 | D BLD^IBJPS1
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | HELP ; -- help code
|
|---|
| 19 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | EXIT ; -- exit code
|
|---|
| 23 | K ^TMP("IBJPS",$J),^TMP("IBJPSAX",$J)
|
|---|
| 24 | D CLEAR^VALM1
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | NXEDIT ; -- IBJP IB SITE PARAMETER EDIT ACTION (EP): Select data set to edit, do edit
|
|---|
| 28 | N VALMY,IBSELN,IBSET
|
|---|
| 29 | D EN^VALM2($G(XQORNOD(0)))
|
|---|
| 30 | I $D(VALMY) S IBSELN=0 F S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN D
|
|---|
| 31 | . S IBSET=$P($G(^TMP("IBJPSAX",$J,IBSELN)),U,1) Q:'IBSET
|
|---|
| 32 | . D EDIT(IBSET)
|
|---|
| 33 | S VALMBCK="R"
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | EDIT(IBSET) ; edit IB Site Parameters
|
|---|
| 37 | D FULL^VALM1
|
|---|
| 38 | I IBSET'="" S DR=$P($T(@IBSET),";;",2,999)
|
|---|
| 39 | I DR'="" S DIE="^IBE(350.9,",DA=1 D ^DIE K DA,DR,DIE,DIC,X,Y
|
|---|
| 40 | D INIT^IBJPS S VALMBCK="R"
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | 1 ;;.09;.13;.14
|
|---|
| 44 | 2 ;;1.2;.15;.11;.12;7.04
|
|---|
| 45 | 3 ;;1.09;1.07;2.07
|
|---|
| 46 | 4 ;;4.04;6.25;6.24
|
|---|
| 47 | 5 ;;.02;1.14;1.25;1.08
|
|---|
| 48 | 6 ;;1.23;1.16;1.22;1.19;1.15;1.17
|
|---|
| 49 | 7 ;;1.33;1.32;1.31;1.27
|
|---|
| 50 | 8 ;;1.29;1.3;1.18;1.28
|
|---|
| 51 | 9 ;;1.01;1.02;1.05;1.04
|
|---|
| 52 | 10 ;;2.12;2.1;2.02;2.03;2.04;2.05;2.06;2.01
|
|---|
| 53 | 11 ;;2.08;2.09
|
|---|
| 54 | 12 ;;9.01;9.02;9.03;9.11;9.12;9.13;9.14;9.15
|
|---|
| 55 | 13 ;;10.02;10.03;10.04;10.05;D INIT^IBATFILE
|
|---|
| 56 | 14 ;;2.11;8.01;8.09;8.03;8.06;8.04;8.07;8.02;8.12T;8.11T
|
|---|
| 57 | 15 ;;50.01;50.02;50.05;50.06;50.03;50.04;50.07
|
|---|
| 58 | ;
|
|---|
| 59 | ;
|
|---|
| 60 | ADD(IBLN,LNG,ARR) ; output array of address in X, line length=LNG
|
|---|
| 61 | N IBCNT,IBI,IBY,IBX,IBZ K ARR S IBCNT=1
|
|---|
| 62 | F IBI=2:1:4 S IBY=$P(IBLN,U,IBI) I IBY'="" D S ARR(IBCNT)=IBY
|
|---|
| 63 | . S IBX=$G(ARR(IBCNT)) I IBI=4 S IBY=$P($G(^DIC(5,+IBY,0)),U,2)_" "_$P(IBLN,U,5)
|
|---|
| 64 | . S IBZ=$S(IBX'="":IBX_", ",1:"")_IBY I $L(IBZ)'>LNG S IBY=IBZ Q
|
|---|
| 65 | . S IBCNT=IBCNT+1
|
|---|
| 66 | Q
|
|---|
