SDAMQ3.m

SDAMQ3 ;ALB/MJK - AM Background Job/Appointments ; 12/1/91

 ;;5.3;Scheduling;**24,466**;Aug 13, 1993;Build 2

 ;

EN(SDBEG,SDEND) ; -- search appts

 N VAUTD,SDCL,X,SDIVNM,SDNAME,SDT,SDDA,SDREQ,SDNONCNT

 S VAUTD=+$P($G(^DG(43,1,"GL")),U,2) S:'VAUTD VAUTD(+$O(^DG(40.8,0)))=""

 S SDCL=0 F  S SDCL=$O(^SC(SDCL)) Q:'SDCL  S X=$G(^SC(SDCL,0)) I $P(X,U,3)["C" D

 .S SDNONCNT=($P(X,U,17)="Y") ; non-count clinic?

 .S SDNAME=$E($P(X,U),1,30),SDIVNM=""

 .S X=$$DIV^SDAMU(.SDCL,.VAUTD,.SDIVNM,35)

 .S SDT=SDBEG F  S SDT=$O(^SC(SDCL,"S",SDT)) Q:'SDT!(SDT>SDEND)  S SDREQ=$$REQ^SDM1A(.SDT) D

 ..S SDDA=0 F  S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:'SDDA  D CHK(SDCL,SDT,SDDA,.SDIVNM,.SDNAME,.SDREQ)

ENQ Q

 ;

CHK(SDCL,SDT,SDDA,SDIVNM,SDNAME,SDREQ) ; -- check appts

 ; input: SDCL := clinic ifn

 ;         SDT := appt d/t

 ;        SDDA := ifn of appt mutiple

 ;      SDIVNM := division name

 ;      SDNAME := clinic name

 ;       SDREQ := required for credit (ci or co)

 ;

 N SD0,SDC,SDNAT,Y,X,DFN,SDPT,SDOE

 S SD0=$G(^SC(SDCL,"S",SDT,1,SDDA,0)),SDC=$G(^("C")),SDNAT=0,DFN=+SD0

 S SDPT=$G(^DPT(DFN,"S",SDT,0))

 ;

 ; -- must be same clinic

 I SDCL'=+SDPT G CHKQ

 ;

 ; -- valid appointment

 I '$$VALID^SDAM2(DFN,SDCL,SDT,SDDA) G CHKQ

 ;

 ; -- check if canceled or no-showed

 S X=$P(SDPT,U,2) I X'="I",X'="",X'="NT" G CHKQ

 ;

 ; -- re-set for inpatient appt

 I X="I"!(X="") D

 .N Y

 .S Y=$$INP^SDAM2(DFN,SDT)

 .I X'=Y S $P(SDPT,U,2)=Y,^DPT(DFN,"S",SDT,0)=SDPT

 .;I Y="I" D CO(DFN,SDT,SDCL,SDREQ)

 ;

 ; -- non-count processing

 I SDNONCNT D CO(DFN,SDT,SDCL,SDREQ) G CHKQ

 ;

 ; -- has appt been checked in or out

 I SDREQ="CI",SDC!($P(SDC,U,3)) G TOT

 I SDREQ="CO" S SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL) I $P(SDC,U,3),$$CO^SDAMQ(SDOE) G TOT

 G TOT:'SD0

 ;

 ; -- if good appt then set to nt

 I $P(SDPT,U,2)="" S $P(^DPT(DFN,"S",SDT,0),U,2)="NT",SDPT=^(0)

 ;

 ; -- set nt flag

 I $P(SDPT,U,2)="NT" S SDNAT=1

 ;

TOT ; -- set totals clinic

 S X=$G(^TMP("SDSTATS",$J,SDIVNM,"APPT",SDNAME)),^(SDNAME)=(X+SDNAT)_U_($P(X,U,2)+1)

CHKQ Q

 ;

CO(DFN,SDT,SDCL,SDREQ) ; -- attempt to CO quietly for inpats and non-counts

 I SDREQ'="CO" G COQ

 ; -- get encounter ien

 N SDOE S SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL)

 ; -- if not checked out, try to co

 I '$$CO^SDAMQ(SDOE) D EN^SDCOM(SDOE,0)

COQ Q

 ;

BULL(SDIVNM,SDLN,SDTOT) ;

 N SDNAME,NAT,GRAND,OTHER,TGRAND,TNAT

 S SDNAME="",(TNAT,TGRAND,OTHER)=0

 D HDR

 F  S SDNAME=$O(^TMP("SDSTATS",$J,SDIVNM,"APPT",SDNAME)) Q:SDNAME=""  S X=^(SDNAME) D

 .S NAT=+X,GRAND=+$P(X,U,2)

 .S TNAT=TNAT+NAT,TGRAND=TGRAND+GRAND

 .S SDTOT("DIV","NAT")=SDTOT("DIV","NAT")+NAT

 .S SDTOT("DIV","GRAND")=SDTOT("DIV","GRAND")+GRAND

 .I 'NAT S OTHER=OTHER+GRAND

 .I NAT D LINE(SDNAME,NAT,GRAND)

 D LINE("ALL OTHER CLINICS",0,OTHER)

 D SET("         -------------                 ----------------    -------   -------")

 D LINE("Clinic Totals",TNAT,TGRAND)

BULLQ Q

 ;

LINE(CAPTION,NAT,GRAND) ;

 ; input: CAPTION := text for leftmost col

 ;            NAT := # of encounters requiring action

 ;          GRAND := total # of encounters

 N Y

 S Y="",Y=$$SETSTR^VALM1(CAPTION,Y,10,25),Y=$$SETSTR^VALM1($J(NAT,7),Y,43,7),Y=$$SETSTR^VALM1($J(GRAND,7),Y,60,7),Y=$$SETSTR^VALM1($J($S(GRAND:100*(NAT/GRAND),1:0),6,1)_"%",Y,70,7) D SET(Y)

 Q

 ;

SET(X) ;

 S SDLN=SDLN+1,^TMP("SDAMTEXT",$J,SDLN,0)=X

 Q

 ;

HDR ;

 ; input:  SDIVNM := division name

 ;

 D SET("")

 D SET("                                       Appointments          Total")

 D SET("         Clinic                        Requiring Action      Appts     Pct.")

 D SET("         ------                        ----------------    -------   -------")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDAMQ3   3689     printed  Feb 19, 2025@00:14:39                                                                                                                                                                                                      Page 2

SDAMQ3    ;ALB/MJK - AM Background Job/Appointments ; 12/1/91

 +1       ;;5.3;Scheduling;**24,466**;Aug 13, 1993;Build 2

 +2       ;

EN(SDBEG,SDEND) ; -- search appts

 +1        NEW VAUTD,SDCL,X,SDIVNM,SDNAME,SDT,SDDA,SDREQ,SDNONCNT

 +2        SET VAUTD=+$PIECE($GET(^DG(43,1,"GL")),U,2)

           if 'VAUTD

               SET VAUTD(+$ORDER(^DG(40.8,0)))=""

 +3        SET SDCL=0

           FOR 

               SET SDCL=$ORDER(^SC(SDCL))

               if 'SDCL

                   QUIT 

               SET X=$GET(^SC(SDCL,0))

               IF $PIECE(X,U,3)["C"

                   Begin DoDot:1

 +4       ; non-count clinic?

                       SET SDNONCNT=($PIECE(X,U,17)="Y")

 +5                    SET SDNAME=$EXTRACT($PIECE(X,U),1,30)

                       SET SDIVNM=""

 +6                    SET X=$$DIV^SDAMU(.SDCL,.VAUTD,.SDIVNM,35)

 +7                    SET SDT=SDBEG

                       FOR 

                           SET SDT=$ORDER(^SC(SDCL,"S",SDT))

                           if 'SDT!(SDT>SDEND)

                               QUIT 

                           SET SDREQ=$$REQ^SDM1A(.SDT)

                           Begin DoDot:2

 +8                            SET SDDA=0

                               FOR 

                                   SET SDDA=$ORDER(^SC(SDCL,"S",SDT,1,SDDA))

                                   if 'SDDA

                                       QUIT 

                                   DO CHK(SDCL,SDT,SDDA,.SDIVNM,.SDNAME,.SDREQ)

                           End DoDot:2

                   End DoDot:1

ENQ        QUIT 

 +1       ;

CHK(SDCL,SDT,SDDA,SDIVNM,SDNAME,SDREQ) ; -- check appts

 +1       ; input: SDCL := clinic ifn

 +2       ;         SDT := appt d/t

 +3       ;        SDDA := ifn of appt mutiple

 +4       ;      SDIVNM := division name

 +5       ;      SDNAME := clinic name

 +6       ;       SDREQ := required for credit (ci or co)

 +7       ;

 +8        NEW SD0,SDC,SDNAT,Y,X,DFN,SDPT,SDOE

 +9        SET SD0=$GET(^SC(SDCL,"S",SDT,1,SDDA,0))

           SET SDC=$GET(^("C"))

           SET SDNAT=0

           SET DFN=+SD0

 +10       SET SDPT=$GET(^DPT(DFN,"S",SDT,0))

 +11      ;

 +12      ; -- must be same clinic

 +13       IF SDCL'=+SDPT

               GOTO CHKQ

 +14      ;

 +15      ; -- valid appointment

 +16       IF '$$VALID^SDAM2(DFN,SDCL,SDT,SDDA)

               GOTO CHKQ

 +17      ;

 +18      ; -- check if canceled or no-showed

 +19       SET X=$PIECE(SDPT,U,2)

           IF X'="I"

               IF X'=""

                   IF X'="NT"

                       GOTO CHKQ

 +20      ;

 +21      ; -- re-set for inpatient appt

 +22       IF X="I"!(X="")

               Begin DoDot:1

 +23               NEW Y

 +24               SET Y=$$INP^SDAM2(DFN,SDT)

 +25               IF X'=Y

                       SET $PIECE(SDPT,U,2)=Y

                       SET ^DPT(DFN,"S",SDT,0)=SDPT

 +26      ;I Y="I" D CO(DFN,SDT,SDCL,SDREQ)

               End DoDot:1

 +27      ;

 +28      ; -- non-count processing

 +29       IF SDNONCNT

               DO CO(DFN,SDT,SDCL,SDREQ)

               GOTO CHKQ

 +30      ;

 +31      ; -- has appt been checked in or out

 +32       IF SDREQ="CI"

               IF SDC!($PIECE(SDC,U,3))

                   GOTO TOT

 +33       IF SDREQ="CO"

               SET SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL)

               IF $PIECE(SDC,U,3)

                   IF $$CO^SDAMQ(SDOE)

                       GOTO TOT

 +34       if 'SD0

               GOTO TOT

 +35      ;

 +36      ; -- if good appt then set to nt

 +37       IF $PIECE(SDPT,U,2)=""

               SET $PIECE(^DPT(DFN,"S",SDT,0),U,2)="NT"

               SET SDPT=^(0)

 +38      ;

 +39      ; -- set nt flag

 +40       IF $PIECE(SDPT,U,2)="NT"

               SET SDNAT=1

 +41      ;

TOT       ; -- set totals clinic

 +1        SET X=$GET(^TMP("SDSTATS",$JOB,SDIVNM,"APPT",SDNAME))

           SET ^(SDNAME)=(X+SDNAT)_U_($PIECE(X,U,2)+1)

CHKQ       QUIT 

 +1       ;

CO(DFN,SDT,SDCL,SDREQ) ; -- attempt to CO quietly for inpats and non-counts

 +1        IF SDREQ'="CO"

               GOTO COQ

 +2       ; -- get encounter ien

 +3        NEW SDOE

           SET SDOE=+$$GETAPT^SDVSIT2(DFN,SDT,SDCL)

 +4       ; -- if not checked out, try to co

 +5        IF '$$CO^SDAMQ(SDOE)

               DO EN^SDCOM(SDOE,0)

COQ        QUIT 

 +1       ;

BULL(SDIVNM,SDLN,SDTOT) ;

 +1        NEW SDNAME,NAT,GRAND,OTHER,TGRAND,TNAT

 +2        SET SDNAME=""

           SET (TNAT,TGRAND,OTHER)=0

 +3        DO HDR

 +4        FOR 

               SET SDNAME=$ORDER(^TMP("SDSTATS",$JOB,SDIVNM,"APPT",SDNAME))

               if SDNAME=""

                   QUIT 

               SET X=^(SDNAME)

               Begin DoDot:1

 +5                SET NAT=+X

                   SET GRAND=+$PIECE(X,U,2)

 +6                SET TNAT=TNAT+NAT

                   SET TGRAND=TGRAND+GRAND

 +7                SET SDTOT("DIV","NAT")=SDTOT("DIV","NAT")+NAT

 +8                SET SDTOT("DIV","GRAND")=SDTOT("DIV","GRAND")+GRAND

 +9                IF 'NAT

                       SET OTHER=OTHER+GRAND

 +10               IF NAT

                       DO LINE(SDNAME,NAT,GRAND)

               End DoDot:1

 +11       DO LINE("ALL OTHER CLINICS",0,OTHER)

 +12       DO SET("         -------------                 ----------------    -------   -------")

 +13       DO LINE("Clinic Totals",TNAT,TGRAND)

BULLQ      QUIT 

 +1       ;

LINE(CAPTION,NAT,GRAND) ;

 +1       ; input: CAPTION := text for leftmost col

 +2       ;            NAT := # of encounters requiring action

 +3       ;          GRAND := total # of encounters

 +4        NEW Y

 +5        SET Y=""

           SET Y=$$SETSTR^VALM1(CAPTION,Y,10,25)

           SET Y=$$SETSTR^VALM1($JUSTIFY(NAT,7),Y,43,7)

           SET Y=$$SETSTR^VALM1($JUSTIFY(GRAND,7),Y,60,7)

           SET Y=$$SETSTR^VALM1($JUSTIFY($SELECT(GRAND:100*(NAT/GRAND),1:0),6,1)_"%",Y,70,7)

           DO SET(Y)

 +6        QUIT 

 +7       ;

SET(X)    ;

 +1        SET SDLN=SDLN+1

           SET ^TMP("SDAMTEXT",$JOB,SDLN,0)=X

 +2        QUIT 

 +3       ;

HDR       ;

 +1       ; input:  SDIVNM := division name

 +2       ;

 +3        DO SET("")

 +4        DO SET("                                       Appointments          Total")

 +5        DO SET("         Clinic                        Requiring Action      Appts     Pct.")

 +6        DO SET("         ------                        ----------------    -------   -------")

 +7        QUIT