SDWLAHRE ;;IOFO BAY PINES/TEH - EWL REPORT - REPORT EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM
;;5.3;scheduling;**419,1015**;AUG 13 1993;Build 21
;
;
;
;
;
;
;
EDT ;EDIT TEMPLATE
K DIR
W ! S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this SORT template correct" D ^DIR
I Y Q
I 'Y D
.S SDWLSTC=1
.K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Delete ALL of the SORT template(s)" D ^DIR
.I Y D
..K ^XTMP("SDWLAHR",$J),SDWLSTC W *7," Sort Template deleted." S SDWLC=0 Q
G END:'SDWLC
I SDWLC=1,'SDWLSTC S SDWLID=SDWLC
K DIR I SDWLC>1 S DIR("A")="Delete Which ID: ",DIR(0)="NAO^1:"_SDWLC_":0" D ^DIR D
.I Y="",X Q
.I Y["^" Q
.I Y<1 Q
.I Y["^" Q
.S SDWLID=Y
.S SDWLS0="",SDWLS1=""
.S SDWLS0=$O(^XTMP("SDWLAHR",$J,SDWLID,SDWLS0)),SDWLS1=$O(^XTMP("SDWLAHR",$J,SDWLID,SDWLS0,SDWLS1))
.S SDWLS3=+$G(^XTMP("SDWLAHR",$J,SDWLID,SDWLS0,SDWLS1))
K ^XTMP("SDWLAHR",$J,SDWLID),^XTMP("SDWLAHR",$J,"B"),^XTMP("SDWLAHR",$J,"C")
SET S SDWLM=0,SDWLS=0
F S SDWLM=$O(^XTMP("SDWLAHR",$J,SDWLM)) Q:SDWLM<1 D
.S SDWLM0="" F S SDWLM0=$O(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0)) Q:SDWLM0="" D
..S SDWLM1="" F S SDWLM1=$O(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0,SDWLM1)) Q:SDWLM1="" D
...S X=$G(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0,SDWLM1))
...S SDWLM2="" F S SDWLM2=$O(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0,SDWLM1,SDWLM2)) Q:SDWLM2="" D
....S Y=$G(^XTMP("SDWLAHR",$J,SDWLM,SDWLM0,SDWLM1,SDWLM2))
....S SDWLS=SDWLS+1,^XTMP("SDWLAHR",$J,SDWLS,SDWLM0,SDWLM1)=X,^XTMP("SDWLAHR",$J,SDWLS,SDWLM0,SDWLM1,SDWLM2)=Y
....S ^XTMP("SDWLAHR",$J,"B",SDWLM0,SDWLM1,Y,SDWLM2,SDWLS)="",^XTMP("SDWLAHR",$J,"C",+X,SDWLS)=""
....K ^XTMP("SDWLAHR",$J,SDWLM) S SDWLC=SDWLS D DIS
END K SDWLCC,SDWLF,SDWLID,SDWLM,SDWLMO,SDWLM1,SDWLM2,SDWLMN,SDWLMX,SDWLS,SDWLS0,SDWLS1,SDWLS2,SDWLS3,SDWLX Q
DIS W:$D(IOF) @IOF W !,?80-$L("EWL AD HOC Report Sort Display")\2,"EWL AD HOC Report Sort Display",!
W !,"Sort ID",?9,"Sort Field ID",?30,"Sort Field Name",?50,"Sort Field Condition"
W !,"-------",?9,"-------------",?30,"---------------",?50,"-----------------------",!
S (SDWLS0,SDWLS1,SDWLS2,SDWLS3,SDWLCC)="" N SDWLIENS
F S SDWLCC=$O(^XTMP("SDWLAHR",$J,SDWLCC)) Q:SDWLCC<1 D
.F S SDWLS0=$O(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0)) Q:SDWLS0="" D
..F S SDWLS1=$O(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1)) Q:SDWLS1="" D
...S SDWLX=$G(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1))
...W !,?3,SDWLCC,?13,$J($P(SDWLX,";"),3),?30,$E(SDWLS1,1,18)
...S SDWLS2="" F S SDWLS2=$O(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1,SDWLS2)) Q:SDWLS2="" D
....I SDWLS0["DAT" D Q
.....S Y=$P(SDWLS2,U) D DD^%DT W ?50,"Begin Date: ",Y S Y=$P(SDWLS2,U,2) D DD^%DT W !,?50,"End Date: ",Y
....I SDWLS0["NUM" D Q
.....S SDWLMN=$P(SDWLS2,U) W ?50,"Minimun: ",SDWLMN S SDWLMX=$P(SDWLS2,U,2) W !,?50,"Maximun: ",SDWLMX
....I SDWLS0["PRT" D Q
.....S SDWLF=+$P($P(SDWLX,U,2),"P",2)
.....S SDWLIENS=$G(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1,SDWLS2)) W ?50,$$GET1^DIQ(SDWLF,SDWLIENS_",",".01"),!
....I SDWLS0["RS" D Q
.....W ?50,SDWLS2,!
....I SDWLS0["FT" D Q
.....F S SDWLS3=$O(^XTMP("SDWLAHR",$J,SDWLCC,SDWLS0,SDWLS1,SDWLS2,SDWLS3)) Q:SDWLS3="" D
......W:SDWLS2#2>0 ?50,"L-",SDWLS2,?55,SDWLS3
......W:SDWLS2#2=0 !,?50,"L-",SDWLS2,?55,SDWLS3
Q
SDWLAHRE ;;IOFO BAY PINES/TEH - EWL REPORT - REPORT EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM
+1 ;;5.3;scheduling;**419,1015**;AUG 13 1993;Build 21
+2 ;
+3 ;
+4 ;
+5 ;
+6 ;
+7 ;
+8 ;
EDT ;EDIT TEMPLATE
+1 KILL DIR
+2 WRITE !
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Is this SORT template correct"
DO ^DIR
+3 IF Y
QUIT
+4 IF 'Y
Begin DoDot:1
+5 SET SDWLSTC=1
+6 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Delete ALL of the SORT template(s)"
DO ^DIR
+7 IF Y
Begin DoDot:2
+8 KILL ^XTMP("SDWLAHR",$JOB),SDWLSTC
WRITE *7," Sort Template deleted."
SET SDWLC=0
QUIT
End DoDot:2
End DoDot:1
+9 IF 'SDWLC
GOTO END
+10 IF SDWLC=1
IF 'SDWLSTC
SET SDWLID=SDWLC
+11 KILL DIR
IF SDWLC>1
SET DIR("A")="Delete Which ID: "
SET DIR(0)="NAO^1:"_SDWLC_":0"
DO ^DIR
Begin DoDot:1
+12 IF Y=""
IF X
QUIT
+13 IF Y["^"
QUIT
+14 IF Y<1
QUIT
+15 IF Y["^"
QUIT
+16 SET SDWLID=Y
+17 SET SDWLS0=""
SET SDWLS1=""
+18 SET SDWLS0=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLID,SDWLS0))
SET SDWLS1=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLID,SDWLS0,SDWLS1))
+19 SET SDWLS3=+$GET(^XTMP("SDWLAHR",$JOB,SDWLID,SDWLS0,SDWLS1))
End DoDot:1
+20 KILL ^XTMP("SDWLAHR",$JOB,SDWLID),^XTMP("SDWLAHR",$JOB,"B"),^XTMP("SDWLAHR",$JOB,"C")
SET SET SDWLM=0
SET SDWLS=0
+1 FOR
SET SDWLM=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLM))
IF SDWLM<1
QUIT
Begin DoDot:1
+2 SET SDWLM0=""
FOR
SET SDWLM0=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLM,SDWLM0))
IF SDWLM0=""
QUIT
Begin DoDot:2
+3 SET SDWLM1=""
FOR
SET SDWLM1=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLM,SDWLM0,SDWLM1))
IF SDWLM1=""
QUIT
Begin DoDot:3
+4 SET X=$GET(^XTMP("SDWLAHR",$JOB,SDWLM,SDWLM0,SDWLM1))
+5 SET SDWLM2=""
FOR
SET SDWLM2=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLM,SDWLM0,SDWLM1,SDWLM2))
IF SDWLM2=""
QUIT
Begin DoDot:4
+6 SET Y=$GET(^XTMP("SDWLAHR",$JOB,SDWLM,SDWLM0,SDWLM1,SDWLM2))
+7 SET SDWLS=SDWLS+1
SET ^XTMP("SDWLAHR",$JOB,SDWLS,SDWLM0,SDWLM1)=X
SET ^XTMP("SDWLAHR",$JOB,SDWLS,SDWLM0,SDWLM1,SDWLM2)=Y
+8 SET ^XTMP("SDWLAHR",$JOB,"B",SDWLM0,SDWLM1,Y,SDWLM2,SDWLS)=""
SET ^XTMP("SDWLAHR",$JOB,"C",+X,SDWLS)=""
+9 KILL ^XTMP("SDWLAHR",$JOB,SDWLM)
SET SDWLC=SDWLS
DO DIS
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
END KILL SDWLCC,SDWLF,SDWLID,SDWLM,SDWLMO,SDWLM1,SDWLM2,SDWLMN,SDWLMX,SDWLS,SDWLS0,SDWLS1,SDWLS2,SDWLS3,SDWLX
QUIT
DIS IF $DATA(IOF)
WRITE @IOF
WRITE !,?80-$LENGTH("EWL AD HOC Report Sort Display")\2,"EWL AD HOC Report Sort Display",!
+1 WRITE !,"Sort ID",?9,"Sort Field ID",?30,"Sort Field Name",?50,"Sort Field Condition"
+2 WRITE !,"-------",?9,"-------------",?30,"---------------",?50,"-----------------------",!
+3 SET (SDWLS0,SDWLS1,SDWLS2,SDWLS3,SDWLCC)=""
NEW SDWLIENS
+4 FOR
SET SDWLCC=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLCC))
IF SDWLCC<1
QUIT
Begin DoDot:1
+5 FOR
SET SDWLS0=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLCC,SDWLS0))
IF SDWLS0=""
QUIT
Begin DoDot:2
+6 FOR
SET SDWLS1=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLCC,SDWLS0,SDWLS1))
IF SDWLS1=""
QUIT
Begin DoDot:3
+7 SET SDWLX=$GET(^XTMP("SDWLAHR",$JOB,SDWLCC,SDWLS0,SDWLS1))
+8 WRITE !,?3,SDWLCC,?13,$JUSTIFY($PIECE(SDWLX,";"),3),?30,$EXTRACT(SDWLS1,1,18)
+9 SET SDWLS2=""
FOR
SET SDWLS2=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLCC,SDWLS0,SDWLS1,SDWLS2))
IF SDWLS2=""
QUIT
Begin DoDot:4
+10 IF SDWLS0["DAT"
Begin DoDot:5
+11 SET Y=$PIECE(SDWLS2,U)
DO DD^%DT
WRITE ?50,"Begin Date: ",Y
SET Y=$PIECE(SDWLS2,U,2)
DO DD^%DT
WRITE !,?50,"End Date: ",Y
End DoDot:5
QUIT
+12 IF SDWLS0["NUM"
Begin DoDot:5
+13 SET SDWLMN=$PIECE(SDWLS2,U)
WRITE ?50,"Minimun: ",SDWLMN
SET SDWLMX=$PIECE(SDWLS2,U,2)
WRITE !,?50,"Maximun: ",SDWLMX
End DoDot:5
QUIT
+14 IF SDWLS0["PRT"
Begin DoDot:5
+15 SET SDWLF=+$PIECE($PIECE(SDWLX,U,2),"P",2)
+16 SET SDWLIENS=$GET(^XTMP("SDWLAHR",$JOB,SDWLCC,SDWLS0,SDWLS1,SDWLS2))
WRITE ?50,$$GET1^DIQ(SDWLF,SDWLIENS_",",".01"),!
End DoDot:5
QUIT
+17 IF SDWLS0["RS"
Begin DoDot:5
+18 WRITE ?50,SDWLS2,!
End DoDot:5
QUIT
+19 IF SDWLS0["FT"
Begin DoDot:5
+20 FOR
SET SDWLS3=$ORDER(^XTMP("SDWLAHR",$JOB,SDWLCC,SDWLS0,SDWLS1,SDWLS2,SDWLS3))
IF SDWLS3=""
QUIT
Begin DoDot:6
+21 IF SDWLS2#2>0
WRITE ?50,"L-",SDWLS2,?55,SDWLS3
+22 IF SDWLS2#2=0
WRITE !,?50,"L-",SDWLS2,?55,SDWLS3
End DoDot:6
End DoDot:5
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
