BAR50L02 ; IHS/SD/LSL - AR DOWNLOAD FILE LIST ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**21**;OCT 26, 2005
;
;;
D CLEAR^VALM1
EN ;EP -- main entry point list template
D EN^VALM("BAR DWLD FILE LIST")
Q
; *********************************************************************
;
HDR ;EP -- header code
S VALMSG=$$VALMSG^AMCOUT
S VALMHDR(1)=$P($G(^BAREDI("1T",FLNUM,0)),"^")
Q
; *********************************************************************
;
INIT ;EP -- init variables and list array
S VALMCNT=40
Q
; *********************************************************************
;
HELP ;EP -- help code
S X="?"
D DISP^XQORM1,MSG^AMCOUT("",2,0,0)
Q
; *********************************************************************
;
EXIT ;EP -- exit code
D CLEAR^VALM1
Q
; *********************************************************************
;
EXPND ;EP -- expand code
Q
; *********************************************************************
;
RESET ;EP; -- code to rebuild array after action
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0
S VALMBCK="R"
D INIT,HDR
Q
; *********************************************************************
;
GATHER(SUBF) ; -- SUBRTN to set data into array
;
; FILE - file (eg.Med 835)
; SUBF - sub file (eg.Payor Information)
;
S FLST=".01;.02;.03;.04;.05;.06;.07"
S FL06="90056.0106"
S FL02="90056.0102"
S FL=$S(FLNUM="90056.0101":FL02,FLNUM="90056.0105":FL06,1:"")
I FL="" D NODATA Q
S PAD(.01)=9
S PAD(.02)=33
S PAD(.03)=5
S PAD(.04)=8
S PAD(.05)=4
S PAD(.06)=4
S PAD(.07)=12
S LN=0
S D2=0
S RECN=""
S SPACE=" "
S BAREDL("A")="FILE,SUBF,D2"
K ^TMP($J,"RD"),LINE
S LAB="RD"
;
; Get record details for file
D ENPM^XBDIQ1(FL,BAREDL("A"),FLST,"^TMP($J,LAB,")
I '$D(^TMP($J,"RD")) D NODATA Q
;
; Create output array
F S RECN=$O(^TMP($J,"RD",RECN)) Q:RECN="" D
.S (LINE(RECN),FLDNM)=""
.F S FLDNM=$O(^TMP($J,"RD",RECN,FLDNM)) Q:FLDNM="" D
..S DATA=^TMP($J,"RD",RECN,FLDNM)
..I FLDNM=".01" S DATA=SPACE_DATA
..S LINE(RECN)=LINE(RECN)_$$PAD(DATA,PAD(FLDNM))
..S ^TMP($J,"LVL2",1,SUBF,RECN)=LINE(RECN)
..S ^TMP($J,"LVL2","IDX",1,SUBF,RECN)=LINE(RECN)
..Q
;
K LINE
Q
; *********************************************************************
;
NODATA ; No data to be reported
;
S ^TMP($J,"LVL2",1,SUBF,1)="No data available"
S ^TMP($J,"LVL2","IDX",1,SUBF,1)="No data available"
Q
; *********************************************************************
;
GETITEM ; -- select item from list
K BARDR,^TMP($J,"LVL2")
S VALMLST=""
S VALMLST=$O(^TMP($J,"LVL1","IDX",VALMLST),-1)
D EN^VALM2(XQORNOD(0),"O")
I '$D(VALMY) Q
NEW SF,Z
S SF=0
F S SF=$O(VALMY(SF)) Q:SF="" D
. D GATHER(SF)
. S Z=""
. F S Z=$O(^TMP($J,"LVL2","IDX",1,SF,Z)) Q:Z="" D
.. Q:$G(^TMP($J,"LVL2","IDX",1,SF,Z))=""
.. S BARDR(Z)=^TMP($J,"LVL2","IDX",1,SF,Z)
.. S ^TMP($J,"FL",Z,0)=BARDR(Z)
.. S HDR=$G(^TMP($J,"FD",SF))
Q
; *********************************************************************
;
BROWSE(FILE) ;EP; -- called to browse help on screen
; Called by AMCO HELP BROWSE (Browse Help Text) protocol
K ^TMP($J,"LVL2"),^TMP($J,"FL")
D GETITEM I '$D(BARDR) Q
; Segment element details
I FL="90056.0102" D
. S LSTFILE="BAR Segment Element Details"
. D EN^BAR50L03(HDR,LSTFILE)
I FL="90056.0106" D
. S LSTFILE="BAR Table ID Details"
. D EN^BAR50L03(HDR,LSTFILE)
K BARDR
Q
; *********************************************************************
;
EDIT ;EP; -- called to edit document
; called by AMCO HELP EDIT (Add/Edit Help Text) protocol
; called by AMCO DEV HELP EDIT (Add/Edit Help Text) protocol
NEW AMCON,AMCODR,DIE,DR,DA,DIC,DLAYGO
S Y=$$READ^AMCOUT("SBO^ADD:ADD New Document;EDIT:EDIT Existing Document","Select Action")
I Y="ADD" D Q
. S (DIC,DLAYGO)=9002090.45
. S DIC(0)="AEMLQZ"
. D ^DIC
. Q:Y<1
. S DIE="^AMCODOC("
. S DA=+Y
. S DR=".01:999"
. D ^DIE
;
D GETITEM
I '$D(AMCODR) Q
S AMCON=0
F S AMCON=$O(AMCODR(AMCON)) Q:'AMCON D
. S DIE="^AMCODOC("
. S DA=AMCODR(AMCON)
. S DR=".01:999"
. D ^DIE
Q
; *********************************************************************
;
PRINT ;EP; call to print help documents on paper
; Called by AMCO HELP PRINT (Print Help Text) protocol
NEW AMCODR,%ZIS,POP
D GETITEM
I '$D(AMCODR) Q
S %ZIS="QP"
D ^%ZIS
Q:POP
I $D(IO("Q")) D Q
. S ZTRTN="PRINT^AMCOHL1"
. S ZTDESC="OB HELP GUIDE"
. S ZTSAVE("AMCODR(")=""
. K IO("Q")
. D ^%ZTLOAD
. K ZTSK
. D HOME^%ZIS
D CLEAR^VALM1,PRINT^AMCOHL1,RESET
Q
; *********************************************************************
;
PAD(D,L) ; -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
; *********************************************************************
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BAR50L02 ; IHS/SD/LSL - AR DOWNLOAD FILE LIST ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**21**;OCT 26, 2005
+2 ;
+3 ;;
+4 DO CLEAR^VALM1
EN ;EP -- main entry point list template
+1 DO EN^VALM("BAR DWLD FILE LIST")
+2 QUIT
+3 ; *********************************************************************
+4 ;
HDR ;EP -- header code
+1 SET VALMSG=$$VALMSG^AMCOUT
+2 SET VALMHDR(1)=$PIECE($GET(^BAREDI("1T",FLNUM,0)),"^")
+3 QUIT
+4 ; *********************************************************************
+5 ;
INIT ;EP -- init variables and list array
+1 SET VALMCNT=40
+2 QUIT
+3 ; *********************************************************************
+4 ;
HELP ;EP -- help code
+1 SET X="?"
+2 DO DISP^XQORM1
DO MSG^AMCOUT("",2,0,0)
+3 QUIT
+4 ; *********************************************************************
+5 ;
EXIT ;EP -- exit code
+1 DO CLEAR^VALM1
+2 QUIT
+3 ; *********************************************************************
+4 ;
EXPND ;EP -- expand code
+1 QUIT
+2 ; *********************************************************************
+3 ;
RESET ;EP; -- code to rebuild array after action
+1 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+2 DO TERM^VALM0
+3 SET VALMBCK="R"
+4 DO INIT
DO HDR
+5 QUIT
+6 ; *********************************************************************
+7 ;
GATHER(SUBF) ; -- SUBRTN to set data into array
+1 ;
+2 ; FILE - file (eg.Med 835)
+3 ; SUBF - sub file (eg.Payor Information)
+4 ;
+5 SET FLST=".01;.02;.03;.04;.05;.06;.07"
+6 SET FL06="90056.0106"
+7 SET FL02="90056.0102"
+8 SET FL=$SELECT(FLNUM="90056.0101":FL02,FLNUM="90056.0105":FL06,1:"")
+9 IF FL=""
DO NODATA
QUIT
+10 SET PAD(.01)=9
+11 SET PAD(.02)=33
+12 SET PAD(.03)=5
+13 SET PAD(.04)=8
+14 SET PAD(.05)=4
+15 SET PAD(.06)=4
+16 SET PAD(.07)=12
+17 SET LN=0
+18 SET D2=0
+19 SET RECN=""
+20 SET SPACE=" "
+21 SET BAREDL("A")="FILE,SUBF,D2"
+22 KILL ^TMP($JOB,"RD"),LINE
+23 SET LAB="RD"
+24 ;
+25 ; Get record details for file
+26 DO ENPM^XBDIQ1(FL,BAREDL("A"),FLST,"^TMP($J,LAB,")
+27 IF '$DATA(^TMP($JOB,"RD"))
DO NODATA
QUIT
+28 ;
+29 ; Create output array
+30 FOR
SET RECN=$ORDER(^TMP($JOB,"RD",RECN))
IF RECN=""
QUIT
Begin DoDot:1
+31 SET (LINE(RECN),FLDNM)=""
+32 FOR
SET FLDNM=$ORDER(^TMP($JOB,"RD",RECN,FLDNM))
IF FLDNM=""
QUIT
Begin DoDot:2
+33 SET DATA=^TMP($JOB,"RD",RECN,FLDNM)
+34 IF FLDNM=".01"
SET DATA=SPACE_DATA
+35 SET LINE(RECN)=LINE(RECN)_$$PAD(DATA,PAD(FLDNM))
+36 SET ^TMP($JOB,"LVL2",1,SUBF,RECN)=LINE(RECN)
+37 SET ^TMP($JOB,"LVL2","IDX",1,SUBF,RECN)=LINE(RECN)
+38 QUIT
End DoDot:2
End DoDot:1
+39 ;
+40 KILL LINE
+41 QUIT
+42 ; *********************************************************************
+43 ;
NODATA ; No data to be reported
+1 ;
+2 SET ^TMP($JOB,"LVL2",1,SUBF,1)="No data available"
+3 SET ^TMP($JOB,"LVL2","IDX",1,SUBF,1)="No data available"
+4 QUIT
+5 ; *********************************************************************
+6 ;
GETITEM ; -- select item from list
+1 KILL BARDR,^TMP($JOB,"LVL2")
+2 SET VALMLST=""
+3 SET VALMLST=$ORDER(^TMP($JOB,"LVL1","IDX",VALMLST),-1)
+4 DO EN^VALM2(XQORNOD(0),"O")
+5 IF '$DATA(VALMY)
QUIT
+6 NEW SF,Z
+7 SET SF=0
+8 FOR
SET SF=$ORDER(VALMY(SF))
IF SF=""
QUIT
Begin DoDot:1
+9 DO GATHER(SF)
+10 SET Z=""
+11 FOR
SET Z=$ORDER(^TMP($JOB,"LVL2","IDX",1,SF,Z))
IF Z=""
QUIT
Begin DoDot:2
+12 IF $GET(^TMP($JOB,"LVL2","IDX",1,SF,Z))=""
QUIT
+13 SET BARDR(Z)=^TMP($JOB,"LVL2","IDX",1,SF,Z)
+14 SET ^TMP($JOB,"FL",Z,0)=BARDR(Z)
+15 SET HDR=$GET(^TMP($JOB,"FD",SF))
End DoDot:2
End DoDot:1
+16 QUIT
+17 ; *********************************************************************
+18 ;
BROWSE(FILE) ;EP; -- called to browse help on screen
+1 ; Called by AMCO HELP BROWSE (Browse Help Text) protocol
+2 KILL ^TMP($JOB,"LVL2"),^TMP($JOB,"FL")
+3 DO GETITEM
IF '$DATA(BARDR)
QUIT
+4 ; Segment element details
+5 IF FL="90056.0102"
Begin DoDot:1
+6 SET LSTFILE="BAR Segment Element Details"
+7 DO EN^BAR50L03(HDR,LSTFILE)
End DoDot:1
+8 IF FL="90056.0106"
Begin DoDot:1
+9 SET LSTFILE="BAR Table ID Details"
+10 DO EN^BAR50L03(HDR,LSTFILE)
End DoDot:1
+11 KILL BARDR
+12 QUIT
+13 ; *********************************************************************
+14 ;
EDIT ;EP; -- called to edit document
+1 ; called by AMCO HELP EDIT (Add/Edit Help Text) protocol
+2 ; called by AMCO DEV HELP EDIT (Add/Edit Help Text) protocol
+3 NEW AMCON,AMCODR,DIE,DR,DA,DIC,DLAYGO
+4 SET Y=$$READ^AMCOUT("SBO^ADD:ADD New Document;EDIT:EDIT Existing Document","Select Action")
+5 IF Y="ADD"
Begin DoDot:1
+6 SET (DIC,DLAYGO)=9002090.45
+7 SET DIC(0)="AEMLQZ"
+8 DO ^DIC
+9 IF Y<1
QUIT
+10 SET DIE="^AMCODOC("
+11 SET DA=+Y
+12 SET DR=".01:999"
+13 DO ^DIE
End DoDot:1
QUIT
+14 ;
+15 DO GETITEM
+16 IF '$DATA(AMCODR)
QUIT
+17 SET AMCON=0
+18 FOR
SET AMCON=$ORDER(AMCODR(AMCON))
IF 'AMCON
QUIT
Begin DoDot:1
+19 SET DIE="^AMCODOC("
+20 SET DA=AMCODR(AMCON)
+21 SET DR=".01:999"
+22 DO ^DIE
End DoDot:1
+23 QUIT
+24 ; *********************************************************************
+25 ;
PRINT ;EP; call to print help documents on paper
+1 ; Called by AMCO HELP PRINT (Print Help Text) protocol
+2 NEW AMCODR,%ZIS,POP
+3 DO GETITEM
+4 IF '$DATA(AMCODR)
QUIT
+5 SET %ZIS="QP"
+6 DO ^%ZIS
+7 IF POP
QUIT
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTRTN="PRINT^AMCOHL1"
+10 SET ZTDESC="OB HELP GUIDE"
+11 SET ZTSAVE("AMCODR(")=""
+12 KILL IO("Q")
+13 DO ^%ZTLOAD
+14 KILL ZTSK
+15 DO HOME^%ZIS
End DoDot:1
QUIT
+16 DO CLEAR^VALM1
DO PRINT^AMCOHL1
DO RESET
+17 QUIT
+18 ; *********************************************************************
+19 ;
PAD(D,L) ; -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ; *********************************************************************
+4 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
