- 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
