AMEROUT1 ; IHS/ANMC/GIS - SORT CONTROL FOR OUTPUT ;
;;3.0;ER VISIT SYSTEM;**5**;MAR 03, 2009;Build 14
;
RUN D SEL I $D(AMERQUIT) Q
D FSET,PRINT
EXIT K ZTSAVE,ZTSK,ZTIO,ZTDESC,ZTRTN
Q
;
SEL ; SELECT SORT
W !!
S DIR("A")="Sort by"
S1 ; SORT BY LOOP REENTRY POINT
S DIR(0)="N"_$S(AMERRTYP'="A":"O",1:"")_"^1:"_(AMERPTOT+AMERVTOT)_":0"
S DIR("??")="^D SORT^AMEROUT",DIR("?")="Select an attribute of the patient or the visit. Enter a number..."
I $D(AMERNXT) S DIR("A")=AMERNXT K AMERNXT
D ^DIR K DIR
I $E(X)=U,X'="" S AMERQUIT="" Q
D OUT^AMEROUT I $D(AMERQUIT) Q
I X="",$D(AMERSTAT) Q
I X="" Q
I Y?1.2N,$D(^TMP("AMER",$J,7,Y)) S Y=^(Y),AMERATNM=$P(^AMER(2.2,+Y,0),U) W " (",AMERATNM,")" D MET G LOOP
S X=Y,DIC="^AMER(2.2,",DIC(0)="EQ",DIC("S")="I $P(^(0),U,2)=AMERRTYP"
D ^DIC K DIC
D OUT^AMEROUT I $D(AMERQUIT) Q
S Y=+Y,AMERATNM=$P(^AMER(2.2,+Y,0),U) D MET
LOOP I $D(AMERQUIT) Q
I $G(AMERRTYP)="A" Q
D ADD
I $G(AMERSTAT) Q
I AMERRTYP="V"!(AMERRTYP="S") W !! D S1^AMEROUT S DIR("A")="Then sort by" G S1
Q
;
ADD I $D(AMERBY),$D(AMERFR),$D(AMERTO),$D(BY),$D(FR),$D(TO)
E S AMERQUIT="" Q
A1 S:BY="'" BY="" S:BY]"" BY=BY_",",FR=FR_",",TO=TO_","
S BY=BY_AMERBY,FR=FR_AMERFR,TO=TO_AMERTO
Q
;
MET ; METADICTIONARY LOOKUP
K AMERSCR,AMERBY
I 'Y S AMERQUIT="" W " ??",*7 Q
I '$D(^AMER(2.2,+Y,0)) S AMERQUIT="" W " ??",*7 Q
S %=^AMER(2.2,+Y,0),AMERCAT=$P(%,U,3),AMERGBL=$P(%,U,4) S:$D(^(2)) AMERSCR=^(2) I $D(^(1)) S AMERBY=^(1)
I AMERRTYP="V" D @("M"_AMERCAT_"^AMEROUT2") Q
I AMERRTYP="A" D AGE Q
Q
;
FSET ; FINAL ADJUSTMENTS OF BY,FR,TO
I AMERRTYP="A" Q
I $D(AMERSTAT),$G(FLDS)="" S FLDS="!.01"
I AMERDISP=2,BY="" S BY="'@.01,@.02",FR=AMERD1_",",TO=AMERD2_"," Q
I AMERDISP=2 D Q
.I BY="5,.01" S BY=BY_",5,.01:DIAGNOSIS;N;""DX DESCRIPTION: """
.S BY=BY_",",FR=FR_",",TO=TO_"," ; FINAL SET OF BY,FR,TO
.S BY="'@.01,"_BY,FR=AMERD1_","_FR_",",TO=AMERD2_","_TO_","
.I '$D(AMERSTAT) S BY=BY_",.02"
.Q
I AMERDISP=3,BY="" S BY="@.01",FR=AMERD1,TO=AMERD2 Q
I BY="5,.01" S BY=BY_",5,.01:DIAGNOSIS;N;""DX DESCRIPTION: """
I AMERDISP=3 S BY="'@.01,"_BY S:'$D(AMERSTAT) BY=BY_",@.01" S FR=AMERD1_","_FR_",",TO=AMERD2_","_TO_"," Q
I BY="" S BY="@.16",FR=(9999999-AMERD2),TO=(9999999-AMERD1) Q
S BY="'@.01,"_BY S:'$D(AMERSTAT) BY=BY_",@.16" S FR=AMERD1_","_FR_",",TO=AMERD2_","_TO_","
Q
;
PRINT ; GENERATE OUTPUT - ENTRY POINT FROM AMEROUT
I AMERRTYP'="A" S DIC="^AMERVSIT(",DIOBEG="S AMERNOTE="""",^UTILITY($J,2)=""D:$D(AMERNOTE) NOTE^AMEROUT1 ""_^UTILITY($J,2)"
S Y=AMERD1 D DD^%DT S AMERD1=Y
S Y=AMERD2 D DD^%DT S AMERD2=Y
I $G(AMERHDR)'="" S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
E S DHD="ER REPORT"
ENDIP D EN1^DIP
;
;AMER*3.0*5
D LOG^AMERBUSA("P","Q","AMEROUT1","AMER: Printed "_AMERHDR_" for "_AMERD1_" to "_$P(AMERD2,"@"),"")
;
I $D(IOST),IOST["C-",'$D(DIRUT),'$D(DTOUT) W ! S DIR(0)="E",DIR("A")="Press 'Return to continue" D ^DIR
Q
;
TASK ; BACKGROUND JOB ENTRY POINT
;
Q
;
NOTE ;
K AMERNOTE N I,X
I '$D(^TMP("AMER",$J,8)) Q
W "Please note: the following criteria were used to screen entries:",!
S X="" F I=1:1 S X=$O(^TMP("AMER",$J,8,X)) Q:X="" W !,?3,I,") ",X," = """,^(X),""""
W !!!
Q
;
AGE ; ENTRY POINT
S DIC="^AMERVSIT(",FR=AMERD1,TO=AMERD2
S FLDS="!.02:NUMBER,"_AMERBY_",!D ^AMERBIN"
S BY="'@.01,.02:NUMBER"
S DHD="@"
Q
;
EN1 ; ENTRY POINT FORM OPTION AMER LOG
; PRINT RECENT VISITS
N BY,FR,TO,FLDS,DIC,%,AMERRTYP,AMERHDR,AMERD1,AMERD2,AMERDATE
S AMERRTYP="V"
D NOW^%DTC
S X1=X ;THE DATE THAT X2 WILL BE SUBTRACTED FROM IN FILEMAN FORMAT
S X2=-1 ;TO GET THE DAY BEFORE...
D C^%DTC
S AMERDATE=X
S FR=$P(X,".",1)
S TO=FR
S FLDS="[AMER BRIEF",BY="@.01"
S DIC="^AMERVSIT("
S Y=FR D DD^%DT S AMERD1=Y
S Y=TO D DD^%DT S AMERD2=Y
D SYNCHERS^AMERERS(AMERD1,AMERD2)
S AMERHDR="ER DAILY LOG REPORT"
S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
D EN1^DIP
;
;AMER*3.0*5
D LOG^AMERBUSA("P","Q","AMEROUT1","AMER: Printed ER Daily Log Report","")
;
I $D(IOST),IOST["C-",'$D(DIRUT),'$D(DTOUT) W ! S DIR(0)="E",DIR("A")="Press 'Return to continue" D ^DIR
Q
AMEROUT1 ; IHS/ANMC/GIS - SORT CONTROL FOR OUTPUT ;
+1 ;;3.0;ER VISIT SYSTEM;**5**;MAR 03, 2009;Build 14
+2 ;
RUN DO SEL
IF $DATA(AMERQUIT)
QUIT
+1 DO FSET
DO PRINT
EXIT KILL ZTSAVE,ZTSK,ZTIO,ZTDESC,ZTRTN
+1 QUIT
+2 ;
SEL ; SELECT SORT
+1 WRITE !!
+2 SET DIR("A")="Sort by"
S1 ; SORT BY LOOP REENTRY POINT
+1 SET DIR(0)="N"_$SELECT(AMERRTYP'="A":"O",1:"")_"^1:"_(AMERPTOT+AMERVTOT)_":0"
+2 SET DIR("??")="^D SORT^AMEROUT"
SET DIR("?")="Select an attribute of the patient or the visit. Enter a number..."
+3 IF $DATA(AMERNXT)
SET DIR("A")=AMERNXT
KILL AMERNXT
+4 DO ^DIR
KILL DIR
+5 IF $EXTRACT(X)=U
IF X'=""
SET AMERQUIT=""
QUIT
+6 DO OUT^AMEROUT
IF $DATA(AMERQUIT)
QUIT
+7 IF X=""
IF $DATA(AMERSTAT)
QUIT
+8 IF X=""
QUIT
+9 IF Y?1.2N
IF $DATA(^TMP("AMER",$JOB,7,Y))
SET Y=^(Y)
SET AMERATNM=$PIECE(^AMER(2.2,+Y,0),U)
WRITE " (",AMERATNM,")"
DO MET
GOTO LOOP
+10 SET X=Y
SET DIC="^AMER(2.2,"
SET DIC(0)="EQ"
SET DIC("S")="I $P(^(0),U,2)=AMERRTYP"
+11 DO ^DIC
KILL DIC
+12 DO OUT^AMEROUT
IF $DATA(AMERQUIT)
QUIT
+13 SET Y=+Y
SET AMERATNM=$PIECE(^AMER(2.2,+Y,0),U)
DO MET
LOOP IF $DATA(AMERQUIT)
QUIT
+1 IF $GET(AMERRTYP)="A"
QUIT
+2 DO ADD
+3 IF $GET(AMERSTAT)
QUIT
+4 IF AMERRTYP="V"!(AMERRTYP="S")
WRITE !!
DO S1^AMEROUT
SET DIR("A")="Then sort by"
GOTO S1
+5 QUIT
+6 ;
ADD IF $DATA(AMERBY)
IF $DATA(AMERFR)
IF $DATA(AMERTO)
IF $DATA(BY)
IF $DATA(FR)
IF $DATA(TO)
+1 IF '$TEST
SET AMERQUIT=""
QUIT
A1 IF BY="'"
SET BY=""
IF BY]""
SET BY=BY_","
SET FR=FR_","
SET TO=TO_","
+1 SET BY=BY_AMERBY
SET FR=FR_AMERFR
SET TO=TO_AMERTO
+2 QUIT
+3 ;
MET ; METADICTIONARY LOOKUP
+1 KILL AMERSCR,AMERBY
+2 IF 'Y
SET AMERQUIT=""
WRITE " ??",*7
QUIT
+3 IF '$DATA(^AMER(2.2,+Y,0))
SET AMERQUIT=""
WRITE " ??",*7
QUIT
+4 SET %=^AMER(2.2,+Y,0)
SET AMERCAT=$PIECE(%,U,3)
SET AMERGBL=$PIECE(%,U,4)
IF $DATA(^(2))
SET AMERSCR=^(2)
IF $DATA(^(1))
SET AMERBY=^(1)
+5 IF AMERRTYP="V"
DO @("M"_AMERCAT_"^AMEROUT2")
QUIT
+6 IF AMERRTYP="A"
DO AGE
QUIT
+7 QUIT
+8 ;
FSET ; FINAL ADJUSTMENTS OF BY,FR,TO
+1 IF AMERRTYP="A"
QUIT
+2 IF $DATA(AMERSTAT)
IF $GET(FLDS)=""
SET FLDS="!.01"
+3 IF AMERDISP=2
IF BY=""
SET BY="'@.01,@.02"
SET FR=AMERD1_","
SET TO=AMERD2_","
QUIT
+4 IF AMERDISP=2
Begin DoDot:1
+5 IF BY="5,.01"
SET BY=BY_",5,.01:DIAGNOSIS;N;""DX DESCRIPTION: """
+6 ; FINAL SET OF BY,FR,TO
SET BY=BY_","
SET FR=FR_","
SET TO=TO_","
+7 SET BY="'@.01,"_BY
SET FR=AMERD1_","_FR_","
SET TO=AMERD2_","_TO_","
+8 IF '$DATA(AMERSTAT)
SET BY=BY_",.02"
+9 QUIT
End DoDot:1
QUIT
+10 IF AMERDISP=3
IF BY=""
SET BY="@.01"
SET FR=AMERD1
SET TO=AMERD2
QUIT
+11 IF BY="5,.01"
SET BY=BY_",5,.01:DIAGNOSIS;N;""DX DESCRIPTION: """
+12 IF AMERDISP=3
SET BY="'@.01,"_BY
IF '$DATA(AMERSTAT)
SET BY=BY_",@.01"
SET FR=AMERD1_","_FR_","
SET TO=AMERD2_","_TO_","
QUIT
+13 IF BY=""
SET BY="@.16"
SET FR=(9999999-AMERD2)
SET TO=(9999999-AMERD1)
QUIT
+14 SET BY="'@.01,"_BY
IF '$DATA(AMERSTAT)
SET BY=BY_",@.16"
SET FR=AMERD1_","_FR_","
SET TO=AMERD2_","_TO_","
+15 QUIT
+16 ;
PRINT ; GENERATE OUTPUT - ENTRY POINT FROM AMEROUT
+1 IF AMERRTYP'="A"
SET DIC="^AMERVSIT("
SET DIOBEG="S AMERNOTE="""",^UTILITY($J,2)=""D:$D(AMERNOTE) NOTE^AMEROUT1 ""_^UTILITY($J,2)"
+2 SET Y=AMERD1
DO DD^%DT
SET AMERD1=Y
+3 SET Y=AMERD2
DO DD^%DT
SET AMERD2=Y
+4 IF $GET(AMERHDR)'=""
SET DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+5 IF '$TEST
SET DHD="ER REPORT"
ENDIP DO EN1^DIP
+1 ;
+2 ;AMER*3.0*5
+3 DO LOG^AMERBUSA("P","Q","AMEROUT1","AMER: Printed "_AMERHDR_" for "_AMERD1_" to "_$PIECE(AMERD2,"@"),"")
+4 ;
+5 IF $DATA(IOST)
IF IOST["C-"
IF '$DATA(DIRUT)
IF '$DATA(DTOUT)
WRITE !
SET DIR(0)="E"
SET DIR("A")="Press 'Return to continue"
DO ^DIR
+6 QUIT
+7 ;
TASK ; BACKGROUND JOB ENTRY POINT
+1 ;
+2 QUIT
+3 ;
NOTE ;
+1 KILL AMERNOTE
NEW I,X
+2 IF '$DATA(^TMP("AMER",$JOB,8))
QUIT
+3 WRITE "Please note: the following criteria were used to screen entries:",!
+4 SET X=""
FOR I=1:1
SET X=$ORDER(^TMP("AMER",$JOB,8,X))
IF X=""
QUIT
WRITE !,?3,I,") ",X," = """,^(X),""""
+5 WRITE !!!
+6 QUIT
+7 ;
AGE ; ENTRY POINT
+1 SET DIC="^AMERVSIT("
SET FR=AMERD1
SET TO=AMERD2
+2 SET FLDS="!.02:NUMBER,"_AMERBY_",!D ^AMERBIN"
+3 SET BY="'@.01,.02:NUMBER"
+4 SET DHD="@"
+5 QUIT
+6 ;
EN1 ; ENTRY POINT FORM OPTION AMER LOG
+1 ; PRINT RECENT VISITS
+2 NEW BY,FR,TO,FLDS,DIC,%,AMERRTYP,AMERHDR,AMERD1,AMERD2,AMERDATE
+3 SET AMERRTYP="V"
+4 DO NOW^%DTC
+5 ;THE DATE THAT X2 WILL BE SUBTRACTED FROM IN FILEMAN FORMAT
SET X1=X
+6 ;TO GET THE DAY BEFORE...
SET X2=-1
+7 DO C^%DTC
+8 SET AMERDATE=X
+9 SET FR=$PIECE(X,".",1)
+10 SET TO=FR
+11 SET FLDS="[AMER BRIEF"
SET BY="@.01"
+12 SET DIC="^AMERVSIT("
+13 SET Y=FR
DO DD^%DT
SET AMERD1=Y
+14 SET Y=TO
DO DD^%DT
SET AMERD2=Y
+15 DO SYNCHERS^AMERERS(AMERD1,AMERD2)
+16 SET AMERHDR="ER DAILY LOG REPORT"
+17 SET DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+18 DO EN1^DIP
+19 ;
+20 ;AMER*3.0*5
+21 DO LOG^AMERBUSA("P","Q","AMEROUT1","AMER: Printed ER Daily Log Report","")
+22 ;
+23 IF $DATA(IOST)
IF IOST["C-"
IF '$DATA(DIRUT)
IF '$DATA(DTOUT)
WRITE !
SET DIR(0)="E"
SET DIR("A")="Press 'Return to continue"
DO ^DIR
+24 QUIT
