- 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 ;
