source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJPS.m@ 1000

Last change on this file since 1000 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 1.9 KB
Line 
1IBJPS ;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 ;
5EN ; -- main entry point for IBJP IB SITE PARAMETERS, display IB site parameters
6 D EN^VALM("IBJP IB SITE PARAMETERS")
7 Q
8 ;
9HDR ; -- header code
10 S VALMHDR(1)="Only authorized persons may edit this data."
11 Q
12 ;
13INIT ; -- init variables and list array
14 K ^TMP("IBJPS",$J),^TMP("IBJPSAX",$J)
15 D BLD^IBJPS1
16 Q
17 ;
18HELP ; -- help code
19 S X="?" D DISP^XQORM1 W !!
20 Q
21 ;
22EXIT ; -- exit code
23 K ^TMP("IBJPS",$J),^TMP("IBJPSAX",$J)
24 D CLEAR^VALM1
25 Q
26 ;
27NXEDIT ; -- 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 ;
36EDIT(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 ;
431 ;;.09;.13;.14
442 ;;1.2;.15;.11;.12;7.04
453 ;;1.09;1.07;2.07
464 ;;4.04;6.25;6.24
475 ;;.02;1.14;1.25;1.08
486 ;;1.23;1.16;1.22;1.19;1.15;1.17
497 ;;1.33;1.32;1.31;1.27
508 ;;1.29;1.3;1.18;1.28
519 ;;1.01;1.02;1.05;1.04
5210 ;;2.12;2.1;2.02;2.03;2.04;2.05;2.06;2.01
5311 ;;2.08;2.09
5412 ;;9.01;9.02;9.03;9.11;9.12;9.13;9.14;9.15
5513 ;;10.02;10.03;10.04;10.05;D INIT^IBATFILE
5614 ;;2.11;8.01;8.09;8.03;8.06;8.04;8.07;8.02;8.12T;8.11T
5715 ;;50.01;50.02;50.05;50.06;50.03;50.04;50.07
58 ;
59 ;
60ADD(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
Note: See TracBrowser for help on using the repository browser.