ADEPX.m

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