- AMQQEM22 ; IHS/CMI/THL - EM2 OVERFLOW ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;-----
- VVAR S %="^^VISIT TIMESTAMP^D;142^1^TYPE^F;145^1^PATIENT^F;144^1^LOCATION^F;143^1^SERVICE CATEGORY^F;172^1^CLINIC^F"
- S A="+^AUPNVSIT(AMQP(1),0);$P(^AUPNVSIT(AMQP(1),0),U,3);$P(^AUPNVSIT(AMQP(1),0),U,5);$P(^AUPNVSIT(AMQP(1),0),U,6);$P(^AUPNVSIT(AMQP(1),0),U,7);$P(^AUPNVSIT(AMQP(1),0),U,8)"
- F C=1:1:6 S @G@(C,0)=$P(%,";",C),$P(^(0),U,6)=$E($P(^(0),U,3),1,AMQQEM("HLEN")),$P(^(0),U,7)=AMQQEM("MLEN"),@G@(C,1)="S X="_$P(A,";",C) I C>1 S @G@(C,2)="I X'="""" "_^AMQQ(1,+$P(%,";",C),4,1,1)
- K %,A,B
- Q
- ;
- VISIT N %,A,B,X,Y,Z
- D VVAR
- S (P,AMQQEMP)="^TIMESTAMP^TYPE^PATIENT^LOCATION^SERVICE CATEGORY^CLINIC^"
- S Z="1:TIMESTAMP;2:TYPE;3:PATIENT;4:LOCATION;5:SERVICE CATEGORY;6:CLINIC;"
- 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,1))'="" S @G@(C,2)="I X'="""" "_^(1)
- S Z=Z_(C+1)_":"_"OTHER VISIT 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 $G(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
- D LOOP^AMQQEM2
- Q
- ;
- ACCN ; - EP - ACCESSION NUMBER ; EP FROM AMQQEM2
- S DIR("B")=$S($D(AMQQEM("ACCN")):AMQQEM("ACCN"),1:"NO")
- S DIR(0)="Y"
- S DIR("A")="Want to make the 1st field a sequential (serial) number"
- S DIR("?")="In some cases you may want to enter an serial number (starting with 1 and incrementing by 1 for each entry) as the first field of each record"
- D ^DIR
- K DIR
- S:$D(DUOUT) DIRUT=1
- I X=U W !!,*7,"Sorry, you can't back up here. Enter '^^' if you want to terminate the session" W !! G ACCN
- D CK^AMQQEMAN
- I $D(AMQQQUIT) Q
- S AMQQEM("ACCN")=$S(Y:"YES",1:"NO")
- Q
- ;
- AMQQEM22 ; IHS/CMI/THL - EM2 OVERFLOW ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;-----
- VVAR SET %="^^VISIT TIMESTAMP^D;142^1^TYPE^F;145^1^PATIENT^F;144^1^LOCATION^F;143^1^SERVICE CATEGORY^F;172^1^CLINIC^F"
- +1 SET A="+^AUPNVSIT(AMQP(1),0);$P(^AUPNVSIT(AMQP(1),0),U,3);$P(^AUPNVSIT(AMQP(1),0),U,5);$P(^AUPNVSIT(AMQP(1),0),U,6);$P(^AUPNVSIT(AMQP(1),0),U,7);$P(^AUPNVSIT(AMQP(1),0),U,8)"
- +2 FOR C=1:1:6
- SET @G@(C,0)=$PIECE(%,";",C)
- SET $PIECE(^(0),U,6)=$EXTRACT($PIECE(^(0),U,3),1,AMQQEM("HLEN"))
- SET $PIECE(^(0),U,7)=AMQQEM("MLEN")
- SET @G@(C,1)="S X="_$PIECE(A,";",C)
- IF C>1
- SET @G@(C,2)="I X'="""" "_^AMQQ(1,+$PIECE(%,";",C),4,1,1)
- +3 KILL %,A,B
- +4 QUIT
- +5 ;
- VISIT NEW %,A,B,X,Y,Z
- +1 DO VVAR
- +2 SET (P,AMQQEMP)="^TIMESTAMP^TYPE^PATIENT^LOCATION^SERVICE CATEGORY^CLINIC^"
- +3 SET Z="1:TIMESTAMP;2:TYPE;3:PATIENT;4:LOCATION;5:SERVICE CATEGORY;6:CLINIC;"
- +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,1))'=""
- SET @G@(C,2)="I X'="""" "_^(1)
- End DoDot:1
- +11 SET Z=Z_(C+1)_":"_"OTHER VISIT ATTRIBUTE;"
- +12 SET C("OTHER")=C+1
- +13 SET Z=Z_(C+2)_":EDIT A PREVIOUSLY SELECTED FIELD;"
- +14 SET C("EDIT")=C+2
- +15 SET AMQQEMZ="SO^"_Z
- +16 KILL A,B,Z
- +17 IF $GET(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
- +18 DO LOOP^AMQQEM2
- +19 QUIT
- +20 ;
- ACCN ; - EP - ACCESSION NUMBER ; EP FROM AMQQEM2
- +1 SET DIR("B")=$SELECT($DATA(AMQQEM("ACCN")):AMQQEM("ACCN"),1:"NO")
- +2 SET DIR(0)="Y"
- +3 SET DIR("A")="Want to make the 1st field a sequential (serial) number"
- +4 SET DIR("?")="In some cases you may want to enter an serial number (starting with 1 and incrementing by 1 for each entry) as the first field of each record"
- +5 DO ^DIR
- +6 KILL DIR
- +7 IF $DATA(DUOUT)
- SET DIRUT=1
- +8 IF X=U
- WRITE !!,*7,"Sorry, you can't back up here. Enter '^^' if you want to terminate the session"
- WRITE !!
- GOTO ACCN
- +9 DO CK^AMQQEMAN
- +10 IF $DATA(AMQQQUIT)
- QUIT
- +11 SET AMQQEM("ACCN")=$SELECT(Y:"YES",1:"NO")
- +12 QUIT
- +13 ;
