BSDCLAV.m

BSDCLAV ; IHS/ANMC/LJF - CLINIC AVAIL REPORT ;

 ;;5.3;PIMS;;APR 26, 2002

 ;

EN ; -- main entry point for BSDRM CLINIC AVAILABILITY

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDRM CLINIC AVAILABILITY")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 Q

 ;

INIT ; -- init variables and list array

 K ^TMP("BSDCLAV",$J),^TMP("BSDCLAV1",$J)

 D GUIR^XBLM("IHS^SDCLAV0","^TMP(""BSDCLAV1"",$J,")

 S X=0 F  S X=$O(^TMP("BSDCLAV1",$J,X)) Q:'X  D

 . S VALMCNT=X

 . S ^TMP("BSDCLAV",$J,X,0)=^TMP("BSDCLAV1",$J,X)

 K ^TMP("BSDCLAV1",$J)

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BSDCLAV",$J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

CANC ;EP; called to find cancelled appts

 NEW SDN1,SDN2,SDN3

 S SDN1=0

 F  S SDN1=$O(^DPT("ASDCN",SDC,SDAP,SDN1)) Q:SDN1=""  D

 . S SDN2=$P(^DPT(+SDN1,0),U)

 . S X=$$SCAPPT(SDC,SDAP,SDN1),M1=$P(X,U,2),SDC3=$P(X,U,9)

 . S SDN3=$$HRCN^BDGF2(+SDN1,+$$FAC^BSDU(SDC))

 . S SDN3=$S(SDN3="":"UNKNOWN",1:SDN3)

 . D NM2^SDCLAV0

 Q

 ;

SCAPPT(CLINIC,DATE,PAT) ; return IEN for appt in ^SC

 NEW X,Y

 S X=0 F  S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X  D

 . I $P($G(^SC(CLINIC,"S",DATE,1,X,0)),U)=PAT S Y=X

 Q $G(^SC(CLINIC,"S",DATE,1,+$G(Y),0))

BSDCLAV   ; IHS/ANMC/LJF - CLINIC AVAIL REPORT ;

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

EN        ; -- main entry point for BSDRM CLINIC AVAILABILITY

 +1        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +2        DO EN^VALM("BSDRM CLINIC AVAILABILITY")

 +3        DO CLEAR^VALM1

 +4        QUIT 

 +5       ;

HDR       ; -- header code

 +1        QUIT 

 +2       ;

INIT      ; -- init variables and list array

 +1        KILL ^TMP("BSDCLAV",$JOB),^TMP("BSDCLAV1",$JOB)

 +2        DO GUIR^XBLM("IHS^SDCLAV0","^TMP(""BSDCLAV1"",$J,")

 +3        SET X=0

           FOR 

               SET X=$ORDER(^TMP("BSDCLAV1",$JOB,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +4                SET VALMCNT=X

 +5                SET ^TMP("BSDCLAV",$JOB,X,0)=^TMP("BSDCLAV1",$JOB,X)

               End DoDot:1

 +6        KILL ^TMP("BSDCLAV1",$JOB)

 +7        QUIT 

 +8       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("BSDCLAV",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

CANC      ;EP; called to find cancelled appts

 +1        NEW SDN1,SDN2,SDN3

 +2        SET SDN1=0

 +3        FOR 

               SET SDN1=$ORDER(^DPT("ASDCN",SDC,SDAP,SDN1))

               IF SDN1=""

                   QUIT 

               Begin DoDot:1

 +4                SET SDN2=$PIECE(^DPT(+SDN1,0),U)

 +5                SET X=$$SCAPPT(SDC,SDAP,SDN1)

                   SET M1=$PIECE(X,U,2)

                   SET SDC3=$PIECE(X,U,9)

 +6                SET SDN3=$$HRCN^BDGF2(+SDN1,+$$FAC^BSDU(SDC))

 +7                SET SDN3=$SELECT(SDN3="":"UNKNOWN",1:SDN3)

 +8                DO NM2^SDCLAV0

               End DoDot:1

 +9        QUIT 

 +10      ;

SCAPPT(CLINIC,DATE,PAT) ; return IEN for appt in ^SC

 +1        NEW X,Y

 +2        SET X=0

           FOR 

               SET X=$ORDER(^SC(CLINIC,"S",DATE,1,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +3                IF $PIECE($GET(^SC(CLINIC,"S",DATE,1,X,0)),U)=PAT

                       SET Y=X

               End DoDot:1

 +4        QUIT $GET(^SC(CLINIC,"S",DATE,1,+$GET(Y),0))