BSDSCPAT.m

BSDSCPAT ; IHS/ANMC/LJF - Provider's Patients ;

 ;;5.3;PIMS;;APR 26, 2002

 ;

EN ; -- main entry point

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDSC PRACT PATIENTS")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 Q

 ;

INIT ; -- init variables and list array

 K ^TMP("BSDSCPAT",$J),^TMP("BSDSCPAT1",$J)

 D GUIR^XBLM("IHS^SCRPPAT","^TMP(""BSDSCPAT1"",$J,")

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

 . S VALMCNT=X

 . S ^TMP("BSDSCPAT",$J,X,0)=^TMP("BSDSCPAT1",$J,X)

 K ^TMP("BSDSCPAT1",$J)

 Q

 ;

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 D END^SCRPW50 K ^TMP("BSDSCPAT",$J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

FORMAT ;EP; formats data dislay line

 ; called by STOR^SCRPPAT2

 S @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME

 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),22)=$P(PINF,U,3)  ;HRCN

 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),32)=$P(PINF,"^",8)  ;last appt

 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),52)=$P(PINF,"^",9)  ;nxt appt

 Q

 ;

SHEAD ;EP; set up column headings

 ; called by SHEAD^SCRPPAT3

 S @STORE@("H2")="Pt Name"

 S $E(@STORE@("H2"),22)="Pt ID"

 S $E(@STORE@("H1"),32)="Last Team"

 S $E(@STORE@("H2"),32)="Appt & Clinic"

 S $E(@STORE@("H1"),52)="Next Team"

 S $E(@STORE@("H2"),52)="Appt & Clinic"

 S $P(@STORE@("H3"),"=",80)=""

 Q

BSDSCPAT  ; IHS/ANMC/LJF - Provider's Patients ;

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

 +2       ;

EN        ; -- main entry point

 +1        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +2        DO EN^VALM("BSDSC PRACT PATIENTS")

 +3        DO CLEAR^VALM1

 +4        QUIT 

 +5       ;

HDR       ; -- header code

 +1        QUIT 

 +2       ;

INIT      ; -- init variables and list array

 +1        KILL ^TMP("BSDSCPAT",$JOB),^TMP("BSDSCPAT1",$JOB)

 +2        DO GUIR^XBLM("IHS^SCRPPAT","^TMP(""BSDSCPAT1"",$J,")

 +3        SET X=0

           FOR 

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

               IF 'X

                   QUIT 

               Begin DoDot:1

 +4                SET VALMCNT=X

 +5                SET ^TMP("BSDSCPAT",$JOB,X,0)=^TMP("BSDSCPAT1",$JOB,X)

               End DoDot:1

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

 +7        QUIT 

 +8       ;

 +9       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        DO END^SCRPW50

           KILL ^TMP("BSDSCPAT",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

FORMAT    ;EP; formats data dislay line

 +1       ; called by STOR^SCRPPAT2

 +2        SET @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME

 +3       ;HRCN

           SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),22)=$PIECE(PINF,U,3)

 +4       ;last appt

           SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),32)=$PIECE(PINF,"^",8)

 +5       ;nxt appt

           SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),52)=$PIECE(PINF,"^",9)

 +6        QUIT 

 +7       ;

SHEAD     ;EP; set up column headings

 +1       ; called by SHEAD^SCRPPAT3

 +2        SET @STORE@("H2")="Pt Name"

 +3        SET $EXTRACT(@STORE@("H2"),22)="Pt ID"

 +4        SET $EXTRACT(@STORE@("H1"),32)="Last Team"

 +5        SET $EXTRACT(@STORE@("H2"),32)="Appt & Clinic"

 +6        SET $EXTRACT(@STORE@("H1"),52)="Next Team"

 +7        SET $EXTRACT(@STORE@("H2"),52)="Appt & Clinic"

 +8        SET $PIECE(@STORE@("H3"),"=",80)=""

 +9        QUIT