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 ;
