- SDAMOS0 ;ALB/SCK - AM MGT REPORTS STATISTICS BUILD GLOBAL ;5/25/93
- ;;5.3;Scheduling;;Aug 13, 1993
- ;
- STOPC ; build global of action counts from division/stopcode in TMP
- N I,SDFIN
- S SDT=SDBEG F S SDT=$O(^SCE("B",SDT)) Q:'SDT!(SDT>SDEND) D
- . S SDOE=0 F S SDOE=$O(^SCE("B",SDT,SDOE)) Q:'SDOE D
- .. I '$D(^SCE(SDOE,0)) Q
- .. S SDOEO=$G(^SCE(SDOE,0))
- .. I '$$OKDIV(+$P($G(SDOEO),U,11))!('$$STCHK(+$P($G(SDOEO),U,3))) Q
- .. S SDDIV=$P($G(^DG(40.8,+$P($G(SDOEO),U,11),0)),U)
- .. S SDCODE=$P($G(^DIC(40.7,+$P(SDOEO,U,3),0)),U)
- .. I $P($G(SDOEO),U,12)>0 S ^TMP("SDAMS",$J,SDDIV,SDCODE,+$P(SDOEO,U,12))=$G(^TMP("SDAMS",$J,SDDIV,SDCODE,+$P(SDOEO,U,12)))+1
- K SDT,SDOE,SDOEO,SDDIV,SDCODE
- Q
- ;
- OKDIV(SDDV) ; check for division in list of valid divisions (vautd)
- N Y S Y=0
- I VAUTD S Y=1 G OKDIVQ
- I $D(VAUTD(SDDV)) S Y=1
- OKDIVQ Q (+Y)
- ;
- STCHK(SDSTC) ; check for stopcode in list of valid stopcodes (vautc)
- N Y S Y=0
- I VAUTC S Y=1 G STCHKQ
- I $D(VAUTC(SDSTC)) S Y=1
- STCHKQ Q (+Y)
- ;
- DISP() ; -- display selection choices
- N C,D
- D HOME^%ZIS W @IOF,*13
- W $$LINE^SDAMO("Report Specifications")
- W !!," Encounter Dates: ",$$FDATE^VALM1(SDBEG)," to ",$$FDATE^VALM1(SDEND)
- W !," Report Format: ",$S(FMT=1:"Appointment Clinics",1:"Stop Codes")
- W !!?15,"Divisions",?55,$S(FMT=1:"Clinics",1:"Stop Codes")
- W !?15,"---------",?55,"----------"
- S (D,C)=0
- I VAUTD!VAUTC S D=$S(VAUTD:"All",1:$O(VAUTD(0))),C=$S(VAUTC:"All",1:$O(VAUTC(0))) W !?15,$S(D:VAUTD(D),1:D),?55,$S(C:VAUTC(C),1:C)
- S D=+D,C=+C
- F I=1:1 S:D'="" D=$O(VAUTD(D)) S:C'="" C=$O(VAUTC(C)) Q:'D&('C) W ! W:D ?15,VAUTD(D) W:C ?55,VAUTC(C) I I>9 S I=0 D PAUSE^VALM1 I 'Y G DISPQ
- W !,$$LINE^SDAMO("")
- S Y=1
- DISPQ Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMOS0 1727 printed Jan 18, 2025@03:49:10 Page 2
- SDAMOS0 ;ALB/SCK - AM MGT REPORTS STATISTICS BUILD GLOBAL ;5/25/93
- +1 ;;5.3;Scheduling;;Aug 13, 1993
- +2 ;
- STOPC ; build global of action counts from division/stopcode in TMP
- +1 NEW I,SDFIN
- +2 SET SDT=SDBEG
- FOR
- SET SDT=$ORDER(^SCE("B",SDT))
- if 'SDT!(SDT>SDEND)
- QUIT
- Begin DoDot:1
- +3 SET SDOE=0
- FOR
- SET SDOE=$ORDER(^SCE("B",SDT,SDOE))
- if 'SDOE
- QUIT
- Begin DoDot:2
- +4 IF '$DATA(^SCE(SDOE,0))
- QUIT
- +5 SET SDOEO=$GET(^SCE(SDOE,0))
- +6 IF '$$OKDIV(+$PIECE($GET(SDOEO),U,11))!('$$STCHK(+$PIECE($GET(SDOEO),U,3)))
- QUIT
- +7 SET SDDIV=$PIECE($GET(^DG(40.8,+$PIECE($GET(SDOEO),U,11),0)),U)
- +8 SET SDCODE=$PIECE($GET(^DIC(40.7,+$PIECE(SDOEO,U,3),0)),U)
- +9 IF $PIECE($GET(SDOEO),U,12)>0
- SET ^TMP("SDAMS",$JOB,SDDIV,SDCODE,+$PIECE(SDOEO,U,12))=$GET(^TMP("SDAMS",$JOB,SDDIV,SDCODE,+$PIECE(SDOEO,U,12)))+1
- End DoDot:2
- End DoDot:1
- +10 KILL SDT,SDOE,SDOEO,SDDIV,SDCODE
- +11 QUIT
- +12 ;
- OKDIV(SDDV) ; check for division in list of valid divisions (vautd)
- +1 NEW Y
- SET Y=0
- +2 IF VAUTD
- SET Y=1
- GOTO OKDIVQ
- +3 IF $DATA(VAUTD(SDDV))
- SET Y=1
- OKDIVQ QUIT (+Y)
- +1 ;
- STCHK(SDSTC) ; check for stopcode in list of valid stopcodes (vautc)
- +1 NEW Y
- SET Y=0
- +2 IF VAUTC
- SET Y=1
- GOTO STCHKQ
- +3 IF $DATA(VAUTC(SDSTC))
- SET Y=1
- STCHKQ QUIT (+Y)
- +1 ;
- DISP() ; -- display selection choices
- +1 NEW C,D
- +2 DO HOME^%ZIS
- WRITE @IOF,*13
- +3 WRITE $$LINE^SDAMO("Report Specifications")
- +4 WRITE !!," Encounter Dates: ",$$FDATE^VALM1(SDBEG)," to ",$$FDATE^VALM1(SDEND)
- +5 WRITE !," Report Format: ",$SELECT(FMT=1:"Appointment Clinics",1:"Stop Codes")
- +6 WRITE !!?15,"Divisions",?55,$SELECT(FMT=1:"Clinics",1:"Stop Codes")
- +7 WRITE !?15,"---------",?55,"----------"
- +8 SET (D,C)=0
- +9 IF VAUTD!VAUTC
- SET D=$SELECT(VAUTD:"All",1:$ORDER(VAUTD(0)))
- SET C=$SELECT(VAUTC:"All",1:$ORDER(VAUTC(0)))
- WRITE !?15,$SELECT(D:VAUTD(D),1:D),?55,$SELECT(C:VAUTC(C),1:C)
- +10 SET D=+D
- SET C=+C
- +11 FOR I=1:1
- if D'=""
- SET D=$ORDER(VAUTD(D))
- if C'=""
- SET C=$ORDER(VAUTC(C))
- if 'D&('C)
- QUIT
- WRITE !
- if D
- WRITE ?15,VAUTD(D)
- if C
- WRITE ?55,VAUTC(C)
- IF I>9
- SET I=0
- DO PAUSE^VALM1
- IF 'Y
- GOTO DISPQ
- +12 WRITE !,$$LINE^SDAMO("")
- +13 SET Y=1
- DISPQ QUIT Y