ADEPX ;IHS/HQW/MJL - DENTAL REPORT EXPORTS [ 03/24/1999 8:35 AM ]
;;6.0;ADE;;APRIL 1999
;
;CREATE REPORTS FOR EXPORT TO HFS
;
S U="^"
;SET UP FILE NAME
S ADEFN=$$FILE("ade1")
;GET HFS DEVICE LIST
S ADEHFS=$$HFS()
;PROCESS
S ADEU=$$ADEU^ADEPSUB()
D CALIF^ADEPX01
;
;CALL %ZIS
D ZIS
;OUTPUT REPORT
U IO
D OUT
D ^%ZISC
;
END ;K ^TMP("ADEP",ADEU)
L -^TMP("ADEP",ADEU)
;
Q
;
OUT ;W !
S ADEX=0
F S ADEX=$O(^TMP("ADEP",ADEU,ADEX)) Q:'+ADEX D
. S ADEDAT=^TMP("ADEP",ADEU,ADEX)
. F ADEJ=1:1:$L(ADEDAT,U) D
. . W $P(ADEDAT,U,ADEJ)
. . W:ADEJ'=$L(ADEDAT,U) $C(9)
. W !
Q
;
ZIS N ADECNT
S ADECNT=1
Z1 S IOP=$P(ADEHFS,U,ADECNT)
S %ZIS("IOPAR")="("_$C(34)_ADEFN_$C(34)_":"_$C(34)_"W"_$C(34)_")"
D ^%ZIS
Q:'POP
S ADECNT=ADECNT+1
I ADECNT<$L(ADEHFS,U) G Z1
Q
;
FILE(ADEFN) ;
;Returns path concatenated with filename
;
;If unix then path="/usr/spool/uucppublic"
;if dos then path=$P(^AUTTSITE(1,1),U,2)
;OS data found in $P(^AUTTSITE(1,0),U,21) where 1=unix and 2=dos
;
;EXPORT FILE NAME STRUCTURE:
; ade # ar su . fa month
; where # is a report identifier from 0 to z
; and month is month number from 1 to c
;
N ADEOS,ADEPATH
S ADEFN=ADEFN_"3031.01" ;Concatenate with ASUFAC
S ADEFN=ADEFN_"A" ;Concatenate with Month
;
;PATH
S ADEOS=$P(^AUTTSITE(1,0),U,21) ;Get OS
I ADEOS=1 S ADEPATH="/usr/spool/uucppublic"
I ADEOS=2 S ADEPATH=$P(^AUTTSITE(1,1),U,2)
I 1 S ADEPATH="/usr/ihs/hwhitt"
S ADEFN=ADEPATH_$S(ADEOS=1:"/",1:"\")_ADEFN
;
Q ADEFN
;
HFS() ;RETURNS U-DELIMITED LIST OF HFS DEVICES
;$O THRU %ZIS(1 LOOKING FOR %ZIS(1,D0,"TYPE")="HFS"
;
N ADEX,ADECNT,ADEHFS,ADEIO
S ADEX=0,ADECNT=1,ADEHFS=""
F S ADEX=$O(^%ZIS(1,ADEX)) Q:'+ADEX D
. Q:'$D(^%ZIS(1,ADEX,"TYPE"))
. I $P(^%ZIS(1,ADEX,"TYPE"),U)="HFS" D
. . S ADEIO=$P(^%ZIS(1,ADEX,0),U,2)
. . S:ADEHFS'[ADEIO $P(ADEHFS,U,ADECNT)=ADEIO,ADECNT=ADECNT+1
Q ADEHFS
ADEPX ;IHS/HQW/MJL - DENTAL REPORT EXPORTS [ 03/24/1999 8:35 AM ]
+1 ;;6.0;ADE;;APRIL 1999
+2 ;
+3 ;CREATE REPORTS FOR EXPORT TO HFS
+4 ;
+5 SET U="^"
+6 ;SET UP FILE NAME
+7 SET ADEFN=$$FILE("ade1")
+8 ;GET HFS DEVICE LIST
+9 SET ADEHFS=$$HFS()
+10 ;PROCESS
+11 SET ADEU=$$ADEU^ADEPSUB()
+12 DO CALIF^ADEPX01
+13 ;
+14 ;CALL %ZIS
+15 DO ZIS
+16 ;OUTPUT REPORT
+17 USE IO
+18 DO OUT
+19 DO ^%ZISC
+20 ;
END ;K ^TMP("ADEP",ADEU)
+1 LOCK -^TMP("ADEP",ADEU)
+2 ;
+3 QUIT
+4 ;
OUT ;W !
+1 SET ADEX=0
+2 FOR
SET ADEX=$ORDER(^TMP("ADEP",ADEU,ADEX))
IF '+ADEX
QUIT
Begin DoDot:1
+3 SET ADEDAT=^TMP("ADEP",ADEU,ADEX)
+4 FOR ADEJ=1:1:$LENGTH(ADEDAT,U)
Begin DoDot:2
+5 WRITE $PIECE(ADEDAT,U,ADEJ)
+6 IF ADEJ'=$LENGTH(ADEDAT,U)
WRITE $CHAR(9)
End DoDot:2
+7 WRITE !
End DoDot:1
+8 QUIT
+9 ;
ZIS NEW ADECNT
+1 SET ADECNT=1
Z1 SET IOP=$PIECE(ADEHFS,U,ADECNT)
+1 SET %ZIS("IOPAR")="("_$CHAR(34)_ADEFN_$CHAR(34)_":"_$CHAR(34)_"W"_$CHAR(34)_")"
+2 DO ^%ZIS
+3 IF 'POP
QUIT
+4 SET ADECNT=ADECNT+1
+5 IF ADECNT<$LENGTH(ADEHFS,U)
GOTO Z1
+6 QUIT
+7 ;
FILE(ADEFN) ;
+1 ;Returns path concatenated with filename
+2 ;
+3 ;If unix then path="/usr/spool/uucppublic"
+4 ;if dos then path=$P(^AUTTSITE(1,1),U,2)
+5 ;OS data found in $P(^AUTTSITE(1,0),U,21) where 1=unix and 2=dos
+6 ;
+7 ;EXPORT FILE NAME STRUCTURE:
+8 ; ade # ar su . fa month
+9 ; where # is a report identifier from 0 to z
+10 ; and month is month number from 1 to c
+11 ;
+12 NEW ADEOS,ADEPATH
+13 ;Concatenate with ASUFAC
SET ADEFN=ADEFN_"3031.01"
+14 ;Concatenate with Month
SET ADEFN=ADEFN_"A"
+15 ;
+16 ;PATH
+17 ;Get OS
SET ADEOS=$PIECE(^AUTTSITE(1,0),U,21)
+18 IF ADEOS=1
SET ADEPATH="/usr/spool/uucppublic"
+19 IF ADEOS=2
SET ADEPATH=$PIECE(^AUTTSITE(1,1),U,2)
+20 IF 1
SET ADEPATH="/usr/ihs/hwhitt"
+21 SET ADEFN=ADEPATH_$SELECT(ADEOS=1:"/",1:"\")_ADEFN
+22 ;
+23 QUIT ADEFN
+24 ;
HFS() ;RETURNS U-DELIMITED LIST OF HFS DEVICES
+1 ;$O THRU %ZIS(1 LOOKING FOR %ZIS(1,D0,"TYPE")="HFS"
+2 ;
+3 NEW ADEX,ADECNT,ADEHFS,ADEIO
+4 SET ADEX=0
SET ADECNT=1
SET ADEHFS=""
+5 FOR
SET ADEX=$ORDER(^%ZIS(1,ADEX))
IF '+ADEX
QUIT
Begin DoDot:1
+6 IF '$DATA(^%ZIS(1,ADEX,"TYPE"))
QUIT
+7 IF $PIECE(^%ZIS(1,ADEX,"TYPE"),U)="HFS"
Begin DoDot:2
+8 SET ADEIO=$PIECE(^%ZIS(1,ADEX,0),U,2)
+9 IF ADEHFS'[ADEIO
SET $PIECE(ADEHFS,U,ADECNT)=ADEIO
SET ADECNT=ADECNT+1
End DoDot:2
End DoDot:1
+10 QUIT ADEHFS
