AMQQRMFF.m

AMQQRMFF ; IHS/CMI/THL - ASCII FLAT FILE MAKER ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;-----

CHECK S %=$$KEYCHECK^AMQQUTIL("AMQQZPROG")

 I '% W !!,"Sorry, you do not hold a Q-Man programmer access key.  Request denied!",*7 Q

 I ^DD("OS")'=8 W !!,"Sorry, this option is only available on systems which use Micronetics MUMPS",!,"Request denied!",*7 Q

 I AMQQCCLS'="P" W !!,"Sorry, this option available for searches that have a subject dealing with",!,"patients.",*7 Q

 W @IOF,!,?20,"*****  EXPORT ASCII FILE  *****",!!!

 F I=1:1 S X=$E($T(TEXT+I),4,99) Q:X=""  W !,X

 S AMQQFFF=""

 S AMQV("OPTION")="FF"

EXIT K %

 Q

 ;

TEXT ;

 ;;I will format the output as a flat ASCII file.  Each entry may be up to 256

 ;;characters in length.  The fields are variable length and '^' is used

 ;;as a delimiter.  In a moment, I will ask you for a device.  Queue the job to

 ;;the HOST FILE SERVER and, when prompted, enter the path/name of the file

 ;;which will be created in your directory.

 ;; 

 ;;Altos system users will have to use the "DOS" utilities to convert the file

 ;;to a DOS format when moving the file onto a floppy disk.

 ;;

OUTPUT ; ENTRY POINT FOR PRODUCING A FLAT FILE OUTPUT

 N X,Y,Z,%,A,I,AMQQFFI,AMQQFFX,AMQQFFZ

 I $G(AMQQFFF) G LIST

 S %="NAME^CHART #"

 S X=0

 F  S X=$O(^UTILITY("AMQQ",$J,"VAR NAME",X)) Q:'X  S Y=^(X),%=%_U_$P(^AMQQ(1,+Y,4,$P(Y,U,2),0),U)

 S AMQQFFF=1

 W %,!!

LIST I '$D(^DPT(AMQP(0),0)) Q

 S AMQQFFS=$P(^DPT(AMQP(0),0),U) ; save patient name rather than DFN

 S (AMQQFFS,AMQQFFZ)=AMQQFFS_U_$P($G(^AUPNPAT(AMQP(0),41,DUZ(2),0)),U,2) ; include chart #

 I $P(AMQQFFS,U,2)]"" S $P(AMQQFFS,U,2)=$P(^AUTTLOC(DUZ(2),0),U,7)_$P(AMQQFFS,U,2)

 I $G(AMQQMULL),$D(^UTILITY("AMQQ",$J,"AG",AMQQMULL)) D MLIST Q

 D LSET

 Q

 ;

LSET F AMQQFFI=9:0 S AMQQFFI=$O(^UTILITY("AMQQ",$J,"VAR NAME",AMQQFFI)) Q:'AMQQFFI  S Y=^(AMQQFFI),X=AMQP(AMQQFFI) D TRANS S AMQQFFS=AMQQFFS_U_X

 W AMQQFFS,!

 Q

 ;

TRANS I X="+"!(X="-")!(X="") Q

 I +Y=7 S X=(DT-X)\10000 Q

 I +Y,$P(Y,U,2),$D(^AMQQ(1,+Y,4,$P(Y,U,2),1)) N % X ^(1)

 Q

 ;

MLIST F AMQQHOLD=0:0 S AMQQHOLD=$O(^UTILITY("AMQQ",$J,"AG",AMQQMULL,AMQQHOLD)) Q:'AMQQHOLD  S AMQQFFAG=^(AMQQHOLD) D M1

 K AMQQHOLD,^UTILITY("AMQQ",$J,"AG",AMQQMULL),X,Y,A,I,%,AMQQFFAG

 Q

 ;

M1 S AMQQFFX=AMQQMUFV-1

 F AMQQFFI=1:1:AMQQMUNV S AMQQFFX=$O(^UTILITY("AMQQ",$J,"VAR NAME",AMQQFFX)) Q:'AMQQFFX  S Y=^(AMQQFFX),A=$P(Y,U,2) I A S AMQP(AMQQFFX)=$P(AMQQFFAG,U,A)

 S AMQQFFS=AMQQFFZ

 D LSET

 Q

 ;

AMQQRMFF  ; IHS/CMI/THL - ASCII FLAT FILE MAKER ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;-----

CHECK      SET %=$$KEYCHECK^AMQQUTIL("AMQQZPROG")

 +1        IF '%

               WRITE !!,"Sorry, you do not hold a Q-Man programmer access key.  Request denied!",*7

               QUIT 

 +2        IF ^DD("OS")'=8

               WRITE !!,"Sorry, this option is only available on systems which use Micronetics MUMPS",!,"Request denied!",*7

               QUIT 

 +3        IF AMQQCCLS'="P"

               WRITE !!,"Sorry, this option available for searches that have a subject dealing with",!,"patients.",*7

               QUIT 

 +4        WRITE @IOF,!,?20,"*****  EXPORT ASCII FILE  *****",!!!

 +5        FOR I=1:1

               SET X=$EXTRACT($TEXT(TEXT+I),4,99)

               IF X=""

                   QUIT 

               WRITE !,X

 +6        SET AMQQFFF=""

 +7        SET AMQV("OPTION")="FF"

EXIT       KILL %

 +1        QUIT 

 +2       ;

TEXT      ;

 +1       ;;I will format the output as a flat ASCII file.  Each entry may be up to 256

 +2       ;;characters in length.  The fields are variable length and '^' is used

 +3       ;;as a delimiter.  In a moment, I will ask you for a device.  Queue the job to

 +4       ;;the HOST FILE SERVER and, when prompted, enter the path/name of the file

 +5       ;;which will be created in your directory.

 +6       ;; 

 +7       ;;Altos system users will have to use the "DOS" utilities to convert the file

 +8       ;;to a DOS format when moving the file onto a floppy disk.

 +9       ;;

OUTPUT    ; ENTRY POINT FOR PRODUCING A FLAT FILE OUTPUT

 +1        NEW X,Y,Z,%,A,I,AMQQFFI,AMQQFFX,AMQQFFZ

 +2        IF $GET(AMQQFFF)

               GOTO LIST

 +3        SET %="NAME^CHART #"

 +4        SET X=0

 +5        FOR 

               SET X=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",X))

               IF 'X

                   QUIT 

               SET Y=^(X)

               SET %=%_U_$PIECE(^AMQQ(1,+Y,4,$PIECE(Y,U,2),0),U)

 +6        SET AMQQFFF=1

 +7        WRITE %,!!

LIST       IF '$DATA(^DPT(AMQP(0),0))

               QUIT 

 +1       ; save patient name rather than DFN

           SET AMQQFFS=$PIECE(^DPT(AMQP(0),0),U)

 +2       ; include chart #

           SET (AMQQFFS,AMQQFFZ)=AMQQFFS_U_$PIECE($GET(^AUPNPAT(AMQP(0),41,DUZ(2),0)),U,2)

 +3        IF $PIECE(AMQQFFS,U,2)]""

               SET $PIECE(AMQQFFS,U,2)=$PIECE(^AUTTLOC(DUZ(2),0),U,7)_$PIECE(AMQQFFS,U,2)

 +4        IF $GET(AMQQMULL)

               IF $DATA(^UTILITY("AMQQ",$JOB,"AG",AMQQMULL))

                   DO MLIST

                   QUIT 

 +5        DO LSET

 +6        QUIT 

 +7       ;

LSET       FOR AMQQFFI=9:0

               SET AMQQFFI=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",AMQQFFI))

               IF 'AMQQFFI

                   QUIT 

               SET Y=^(AMQQFFI)

               SET X=AMQP(AMQQFFI)

               DO TRANS

               SET AMQQFFS=AMQQFFS_U_X

 +1        WRITE AMQQFFS,!

 +2        QUIT 

 +3       ;

TRANS      IF X="+"!(X="-")!(X="")

               QUIT 

 +1        IF +Y=7

               SET X=(DT-X)\10000

               QUIT 

 +2        IF +Y

               IF $PIECE(Y,U,2)

                   IF $DATA(^AMQQ(1,+Y,4,$PIECE(Y,U,2),1))

                       NEW %

                       XECUTE ^(1)

 +3        QUIT 

 +4       ;

MLIST      FOR AMQQHOLD=0:0

               SET AMQQHOLD=$ORDER(^UTILITY("AMQQ",$JOB,"AG",AMQQMULL,AMQQHOLD))

               IF 'AMQQHOLD

                   QUIT 

               SET AMQQFFAG=^(AMQQHOLD)

               DO M1

 +1        KILL AMQQHOLD,^UTILITY("AMQQ",$JOB,"AG",AMQQMULL),X,Y,A,I,%,AMQQFFAG

 +2        QUIT 

 +3       ;

M1         SET AMQQFFX=AMQQMUFV-1

 +1        FOR AMQQFFI=1:1:AMQQMUNV

               SET AMQQFFX=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",AMQQFFX))

               IF 'AMQQFFX

                   QUIT 

               SET Y=^(AMQQFFX)

               SET A=$PIECE(Y,U,2)

               IF A

                   SET AMQP(AMQQFFX)=$PIECE(AMQQFFAG,U,A)

 +2        SET AMQQFFS=AMQQFFZ

 +3        DO LSET

 +4        QUIT 

 +5       ;