AMQQEM2.m

AMQQEM2 ; IHS/CMI/THL - FORMAT FLAT FILE ;

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

 ;-----

 S %=""

 S $P(%,"*",79)=""

 W !!,%,!!

 W "So far, so good.  Now I need to know exactly how the ASCII file should look.",!

 I AMQQCCLS="P" D ACCN^AMQQEM22 I $D(AMQQQUIT) Q

 W !!,"Enter the field (variable) names on the header line of the flat file =>"

 D VAR

RUN D @$S(AMQQCCLS="P":"PT",AMQQCCLS="V":"VISIT^AMQQEM22",1:"ERROR")

 I $D(AMQQQUIT) Q

EXIT Q

 ;

VAR K H,AMQQEM("DATE TRANS")

 S C=0

 S G="^UTILITY(""AMQQ"",$J,""FLAT"")"

 S T=0

 S AMQQEMFS=""

 K @G

 S %="^^PATIENT^F;1^1^DOB^D;7^1^AGE^N;39^1^SSN^F;^^RECORD #^F;2^1^SEX^F"

 S A="$P(^DPT(AMQP(0),0),U);$P(^DPT(AMQP(0),0),U,3);(DT-$P(^DPT(AMQP(0),0),U,3))\10000;$P(^DPT(AMQP(0),0),U,9);$P($G(^AUPNPAT(AMQP(0),41,DUZ(2),0)),U,2);$P(^DPT(AMQP(0),0),U,2)"

 S B=";S Y=X X ^DD(""DD"") S X=Y;;;;S X=$S(X=""F"":""FEMALE"",X=""M"":""MALE"",1:"""")"

 F C=1:1:6 S @G@(C,0)=$P(%,";",C),$P(^(0),U,6)=$E($P(^(0),U,3),1,+$G(AMQQEM("HLEN"))),$P(^(0),U,7)="",@G@(C,1)="S X="_$P(A,";",C),@G@(C,2)=$P(B,";",C)

 K %,A,B

 Q

 ;

PT N %,A,B,X,Y,Z

 D VAR

 S (P,AMQQEMP)="^PATIENT NAME^DOB^AGE^SSN^CHART NUMBER^SEX^"

 S Z="1:PATIENT NAME;2:DOB;3:AGE;4:SSN;5:LOCAL RECORD NUMBER;6:SEX;"

 F %=9:0 S %=$O(^UTILITY("AMQQ",$J,"VAR NAME",%)) Q:'%  S X=^(%) D

 .S Y=$P(^AMQQ(1,+X,4,$P(X,U,2),0),U)

 .I P[(U_Y_U) Q

 .S C=C+1,Z=Z_C_":"_Y_";"

 .S @G@(C,0)=+X_U_$P(X,U,2)_U_$E(Y,1,AMQQEM("HLEN"))_U_$S($P(X,U,2)>2:"F",$P(X,U,2)=2:"D",$P(^AMQQ(1,+X,0),U,5)=7:"D",$P(^(0),U,5)=9:"N",1:"F")_U_%_U_$E(Y,1,AMQQEM("HLEN"))_U_($G(AMQQEM("FIX"))+$G(AMQQEM("MLEN")))

 .S @G@(C,1)="S X=AMQP("_%_")"

 .I $G(^AMQQ(1,+X,4,$P(X,U,2),1))'="" S @G@(C,2)="I X'="""" "_^(1)

 .Q

 S Z=Z_(C+1)_":"_"OTHER DEMOGRAPHIC ATTRIBUTE;"

 S C("OTHER")=C+1

 S Z=Z_(C+2)_":EDIT A PREVIOUSLY SELECTED FIELD;"

 S C("EDIT")=C+2

 S AMQQEMZ="SO^"_Z

 K A,B,Z

 I AMQQEM("ACCN")="YES" S C=C+1,@G@(C,0)="^^"_$E("ENTRY #",1,AMQQEM("HLEN"))_"^N^^"_$E("ENTRY #",1,AMQQEM("HLEN"))_U_($G(AMQQEM("FIX"))+$G(AMQQEM("MLEN"))),@G@(C,1)="S X=AMQQTOT",AMQQEMFS=C_U

LOOP ; EP FROM AMQQEM22

 S (I,N)=0,J=1

 W !

 F  D  I $D(AMQQQUIT)!$D(AMQQEMNO) Q

L1 .S DIR("A")="     Your choice",DIR(0)=AMQQEMZ

 .D ^DIR

 .I X=U W !!,"You may not back up here.",!,"Type '^^' if you want to terminate this session.",! G L1

 .I X="",$G(AMQQEMFS)="" W !!,"You have not entered a field yet.",!,"Type '^^' if you want to terminate this session.",! G L1

 .I X="" S AMQQEMNO="" Q

 .I Y?2."^" S AMQQQUIT="" D  Q

 ..I '$D(AMQQEX("TDFN")) Q

 ..S DIK="^AMQQ(3.1,",DA=AMQQEX("TDFN") D ^DIK K DIK,DA

 .I Y=C("OTHER") D OTHER^AMQQEM2O G:'$D(AMQQEMNO) L2 D OOPS Q

 .I Y=C("EDIT") D EDIT D:$D(AMQQEMNO) OOPS Q

L2 .I (U_AMQQEMFS)[(U_Y_U) W !!,"You have already entered this field...Try again!",*7,!! H 2 D OOPS Q

 .I Y=1,AMQQCCLS="P" S AMQQEMN=1 D PATIENT^AMQQEM21 D:'$D(AMQQEMNO)&'$D(AMQQQUIT) ^AMQQEM3 Q

 .I Y=3,AMQQCCLS="V" S AMQQEMN=3 D PATIENT^AMQQEM21 S Y=3 D:'$D(AMQQEMNO)&'$D(AMQQQUIT) ^AMQQEM3 Q

 .S AMQQEMFS=AMQQEMFS_Y_U

 .D ^AMQQEM3

 .I $G(AMQQEMFN)>98 S AMQQEMNO="" Q

 K AMQQEMNO,DIRUT,DTOUT,DUOUT,DIROUT,AMQQEMFN

 Q

 ;

EDIT N %,X,Y,Z,I,J,AMQQFEDT

 S AMQQFEDT=""

 W !!

 I $L(AMQQEMFS,U)=2 S Y=+AMQQEMFS D ^AMQQEM3 Q

 I AMQQEMFS="" W "  ??",*7 Q

 S J=0

 F I=1:1 S X=$P(AMQQEMFS,U,I) Q:X=""  I X S J=J+1

 I J=1,$P(^UTILITY("AMQQ",$J,"FLAT",+AMQQEMFS,0),U,3)="ENTRY #" W "  ??",*7 Q

 S AMQQEMAX=J

 I J=1,X="A" G E1

EQ S DIR(0)="FO^:"

 S DIR("A")="Edit which segment (A-"_$C(64+J)_")"

 S DIR("?")="Enter a segment letter from the display line."

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U S AMQQEMNO="" Q

 I X="^^" S AMQQQUIT="" Q

E1 I X?1U,$A(X)-64'>AMQQEMAX S Y=$P(AMQQEMFS,U,$A(X)-64) D ^AMQQEM3 Q

 W "  ??",*7 G EQ

 Q

 ;

ERROR Q

 ;

OOPS N AMQQEM3

 S AMQQEM3=5

 K AMQQEMNO

 D LIST^AMQQEM3

 Q

 ;

AMQQEM2   ; IHS/CMI/THL - FORMAT FLAT FILE ;

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

 +2       ;-----

 +3        SET %=""

 +4        SET $PIECE(%,"*",79)=""

 +5        WRITE !!,%,!!

 +6        WRITE "So far, so good.  Now I need to know exactly how the ASCII file should look.",!

 +7        IF AMQQCCLS="P"

               DO ACCN^AMQQEM22

               IF $DATA(AMQQQUIT)

                   QUIT 

 +8        WRITE !!,"Enter the field (variable) names on the header line of the flat file =>"

 +9        DO VAR

RUN        DO @$SELECT(AMQQCCLS="P":"PT",AMQQCCLS="V":"VISIT^AMQQEM22",1:"ERROR")

 +1        IF $DATA(AMQQQUIT)

               QUIT 

EXIT       QUIT 

 +1       ;

VAR        KILL H,AMQQEM("DATE TRANS")

 +1        SET C=0

 +2        SET G="^UTILITY(""AMQQ"",$J,""FLAT"")"

 +3        SET T=0

 +4        SET AMQQEMFS=""

 +5        KILL @G

 +6        SET %="^^PATIENT^F;1^1^DOB^D;7^1^AGE^N;39^1^SSN^F;^^RECORD #^F;2^1^SEX^F"

 +7        SET A="$P(^DPT(AMQP(0),0),U);$P(^DPT(AMQP(0),0),U,3);(DT-$P(^DPT(AMQP(0),0),U,3))\10000;$P(^DPT(AMQP(0),0),U,9);$P($G(^AUPNPAT(AMQP(0),41,DUZ(2),0)),U,2);$P(^DPT(AMQP(0),0),U,2)"

 +8        SET B=";S Y=X X ^DD(""DD"") S X=Y;;;;S X=$S(X=""F"":""FEMALE"",X=""M"":""MALE"",1:"""")"

 +9        FOR C=1:1:6

               SET @G@(C,0)=$PIECE(%,";",C)

               SET $PIECE(^(0),U,6)=$EXTRACT($PIECE(^(0),U,3),1,+$GET(AMQQEM("HLEN")))

               SET $PIECE(^(0),U,7)=""

               SET @G@(C,1)="S X="_$PIECE(A,";",C)

               SET @G@(C,2)=$PIECE(B,";",C)

 +10       KILL %,A,B

 +11       QUIT 

 +12      ;

PT         NEW %,A,B,X,Y,Z

 +1        DO VAR

 +2        SET (P,AMQQEMP)="^PATIENT NAME^DOB^AGE^SSN^CHART NUMBER^SEX^"

 +3        SET Z="1:PATIENT NAME;2:DOB;3:AGE;4:SSN;5:LOCAL RECORD NUMBER;6:SEX;"

 +4        FOR %=9:0

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

               IF '%

                   QUIT 

               SET X=^(%)

               Begin DoDot:1

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

 +6                IF P[(U_Y_U)

                       QUIT 

 +7                SET C=C+1

                   SET Z=Z_C_":"_Y_";"

 +8               SET @G@(C,0)=+X_U_$PIECE(X,U,2)_U_$EXTRACT(Y,1,AMQQEM("HLEN"))_U_$SELECT($PIECE(X,U,2)>2:"F",$PIECE(X,U,2)=2:"D",$PIECE(^AMQQ(1,+X,0),U,5)=7:"D",$PIECE(^(0),U,5)=9:"N",1:"F")_U_%_U_$EXTRACT(Y,1,AMQQEM("HLEN"))_U_(...

                   ... $GET(AMQQEM("FIX"))+$GET(AMQQEM("MLEN")))

 +9                SET @G@(C,1)="S X=AMQP("_%_")"

 +10               IF $GET(^AMQQ(1,+X,4,$PIECE(X,U,2),1))'=""

                       SET @G@(C,2)="I X'="""" "_^(1)

 +11               QUIT 

               End DoDot:1

 +12       SET Z=Z_(C+1)_":"_"OTHER DEMOGRAPHIC ATTRIBUTE;"

 +13       SET C("OTHER")=C+1

 +14       SET Z=Z_(C+2)_":EDIT A PREVIOUSLY SELECTED FIELD;"

 +15       SET C("EDIT")=C+2

 +16       SET AMQQEMZ="SO^"_Z

 +17       KILL A,B,Z

 +18       IF AMQQEM("ACCN")="YES"

               SET C=C+1

               SET @G@(C,0)="^^"_$EXTRACT("ENTRY #",1,AMQQEM("HLEN"))_"^N^^"_$EXTRACT("ENTRY #",1,AMQQEM("HLEN"))_U_($GET(AMQQEM("FIX"))+$GET(AMQQEM("MLEN")))

               SET @G@(C,1)="S X=AMQQTOT"

               SET AMQQEMFS=C_U

LOOP      ; EP FROM AMQQEM22

 +1        SET (I,N)=0

           SET J=1

 +2        WRITE !

 +3        FOR 

               Begin DoDot:1

L1                 SET DIR("A")="     Your choice"

                   SET DIR(0)=AMQQEMZ

 +1                DO ^DIR

 +2                IF X=U

                       WRITE !!,"You may not back up here.",!,"Type '^^' if you want to terminate this session.",!

                       GOTO L1

 +3                IF X=""

                       IF $GET(AMQQEMFS)=""

                           WRITE !!,"You have not entered a field yet.",!,"Type '^^' if you want to terminate this session.",!

                           GOTO L1

 +4                IF X=""

                       SET AMQQEMNO=""

                       QUIT 

 +5                IF Y?2."^"

                       SET AMQQQUIT=""

                       Begin DoDot:2

 +6                        IF '$DATA(AMQQEX("TDFN"))

                               QUIT 

 +7                        SET DIK="^AMQQ(3.1,"

                           SET DA=AMQQEX("TDFN")

                           DO ^DIK

                           KILL DIK,DA

                       End DoDot:2

                       QUIT 

 +8                IF Y=C("OTHER")

                       DO OTHER^AMQQEM2O

                       IF '$DATA(AMQQEMNO)

                           GOTO L2

                       DO OOPS

                       QUIT 

 +9                IF Y=C("EDIT")

                       DO EDIT

                       IF $DATA(AMQQEMNO)

                           DO OOPS

                       QUIT 

L2                 IF (U_AMQQEMFS)[(U_Y_U)

                       WRITE !!,"You have already entered this field...Try again!",*7,!!

                       HANG 2

                       DO OOPS

                       QUIT 

 +1                IF Y=1

                       IF AMQQCCLS="P"

                           SET AMQQEMN=1

                           DO PATIENT^AMQQEM21

                           IF '$DATA(AMQQEMNO)&'$DATA(AMQQQUIT)

                               DO ^AMQQEM3

                           QUIT 

 +2                IF Y=3

                       IF AMQQCCLS="V"

                           SET AMQQEMN=3

                           DO PATIENT^AMQQEM21

                           SET Y=3

                           IF '$DATA(AMQQEMNO)&'$DATA(AMQQQUIT)

                               DO ^AMQQEM3

                           QUIT 

 +3                SET AMQQEMFS=AMQQEMFS_Y_U

 +4                DO ^AMQQEM3

 +5                IF $GET(AMQQEMFN)>98

                       SET AMQQEMNO=""

                       QUIT 

               End DoDot:1

               IF $DATA(AMQQQUIT)!$DATA(AMQQEMNO)

                   QUIT 

 +6        KILL AMQQEMNO,DIRUT,DTOUT,DUOUT,DIROUT,AMQQEMFN

 +7        QUIT 

 +8       ;

EDIT       NEW %,X,Y,Z,I,J,AMQQFEDT

 +1        SET AMQQFEDT=""

 +2        WRITE !!

 +3        IF $LENGTH(AMQQEMFS,U)=2

               SET Y=+AMQQEMFS

               DO ^AMQQEM3

               QUIT 

 +4        IF AMQQEMFS=""

               WRITE "  ??",*7

               QUIT 

 +5        SET J=0

 +6        FOR I=1:1

               SET X=$PIECE(AMQQEMFS,U,I)

               IF X=""

                   QUIT 

               IF X

                   SET J=J+1

 +7        IF J=1

               IF $PIECE(^UTILITY("AMQQ",$JOB,"FLAT",+AMQQEMFS,0),U,3)="ENTRY #"

                   WRITE "  ??",*7

                   QUIT 

 +8        SET AMQQEMAX=J

 +9        IF J=1

               IF X="A"

                   GOTO E1

EQ         SET DIR(0)="FO^:"

 +1        SET DIR("A")="Edit which segment (A-"_$CHAR(64+J)_")"

 +2        SET DIR("?")="Enter a segment letter from the display line."

 +3        DO ^DIR

 +4        KILL DIR

 +5        IF $DATA(DUOUT)

               SET DIRUT=1

 +6        IF X=U

               SET AMQQEMNO=""

               QUIT 

 +7        IF X="^^"

               SET AMQQQUIT=""

               QUIT 

E1         IF X?1U

               IF $ASCII(X)-64'>AMQQEMAX

                   SET Y=$PIECE(AMQQEMFS,U,$ASCII(X)-64)

                   DO ^AMQQEM3

                   QUIT 

 +1        WRITE "  ??",*7

           GOTO EQ

 +2        QUIT 

 +3       ;

ERROR      QUIT 

 +1       ;

OOPS       NEW AMQQEM3

 +1        SET AMQQEM3=5

 +2        KILL AMQQEMNO

 +3        DO LIST^AMQQEM3

 +4        QUIT 

 +5       ;