BSDSCO1.m

BSDSCO1 ; IHS/ANMC/LJF - PT HIST ASSIGN LIST TEMPLATE ;

 ;;5.3;PIMS;;APR 26, 2002

 ;

EN ; -- main entry point

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDSC HIST PT ASSIGN")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 Q

 ;

INIT ; -- init variables and list array

 K ^TMP("BSDSCO1",$J),^TMP("BSDSCO11",$J)

 D GUIR^XBLM("IHS^SCRPO1","^TMP(""BSDSCO11"",$J,")

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

 . S VALMCNT=X

 . S ^TMP("BSDSCO1",$J,X,0)=^TMP("BSDSCO11",$J,X)

 K ^TMP("BSDSCO11",$J)

 Q

 ;

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

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

 Q

 ;

EXPND ; -- expand code

 Q

 ;

SHDR(SCX) ;EP; Print report subheader

 ; called by SHDR^SCRPO1

 ;Input: SCX='D' for detail, 'S' for summary

 Q:SCOUT

 I SCX="S" D  Q

 .W !!?62,"Category",?76,"Count",?84,"Percent"

 .W !?30,$E(SCLINE,1,40),"   --------  --------"

 .Q

 W !?20,"Pat.",?28,"Age",?94,"Enrolled",!,"Patient Name"

 W ?20,"Id.",?28,"Group",?37,"Sex",?43,"Team",?57,"Provider"

 W ?73,"Team Position",?89,"PC?",?94,"Clinic",?110,"Act. Date"

 W ?122,"Inac. Date",!

 W "------------------  ------  -------  ----  ------------  --------------  --------------  ---  --------------  ----------  ----------"

 Q

 ;

BSDSCO1   ; IHS/ANMC/LJF - PT HIST ASSIGN LIST TEMPLATE ;

 +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 HIST PT ASSIGN")

 +3        DO CLEAR^VALM1

 +4        QUIT 

 +5       ;

HDR       ; -- header code

 +1        QUIT 

 +2       ;

INIT      ; -- init variables and list array

 +1        KILL ^TMP("BSDSCO1",$JOB),^TMP("BSDSCO11",$JOB)

 +2        DO GUIR^XBLM("IHS^SCRPO1","^TMP(""BSDSCO11"",$J,")

 +3        SET X=0

           FOR 

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

               IF 'X

                   QUIT 

               Begin DoDot:1

 +4                SET VALMCNT=X

 +5                SET ^TMP("BSDSCO1",$JOB,X,0)=^TMP("BSDSCO11",$JOB,X)

               End DoDot:1

 +6        KILL ^TMP("BSDSCO11",$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("BSDSCO1",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

SHDR(SCX) ;EP; Print report subheader

 +1       ; called by SHDR^SCRPO1

 +2       ;Input: SCX='D' for detail, 'S' for summary

 +3        IF SCOUT

               QUIT 

 +4        IF SCX="S"

               Begin DoDot:1

 +5                WRITE !!?62,"Category",?76,"Count",?84,"Percent"

 +6                WRITE !?30,$EXTRACT(SCLINE,1,40),"   --------  --------"

 +7                QUIT 

               End DoDot:1

               QUIT 

 +8        WRITE !?20,"Pat.",?28,"Age",?94,"Enrolled",!,"Patient Name"

 +9        WRITE ?20,"Id.",?28,"Group",?37,"Sex",?43,"Team",?57,"Provider"

 +10       WRITE ?73,"Team Position",?89,"PC?",?94,"Clinic",?110,"Act. Date"

 +11       WRITE ?122,"Inac. Date",!

 +12       WRITE "------------------  ------  -------  ----  ------------  --------------  --------------  ---  --------------  ----------  ----------"

 +13       QUIT 

 +14      ;