BDMLEH.m

BDMLEH ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ; [ 01-FEB-2010 ]

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**1,3,5**;JUN 14, 2007

 ;; ;

EN ; -- main entry point for BDM LETTER INSERT HELP

 D EN^VALM("BDM LETTER INSERT HELP")

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="General Information about letter inserts."

 Q

 ;

INIT ; -- init variables and list array

 K BDMLELH

 NEW BDMX,BDMC,VALMCNT

 S BDMC=0

 S BDMX=0 F  S BDMX=$O(^BDMLETIH(1,1,BDMX)) Q:BDMX'=+BDMX  D

 .S BDMC=BDMC+1,BDMLETH(BDMC,0)=^BDMLETIH(1,1,BDMX,0)

 S VALMCNT=BDMC

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

 ;

INDITEM ;EP - called from protocol

 ;get item

 ;display text

 D TERM^VALM0

 D FULL^VALM1 ;give me full control of screen

 S VALMCNT=BDMLETIC

 NEW BDMIEN,BDMP

 S BDMIEN=0

 S DIR(0)="N^1:"_BDMLETIC_":0",DIR("A")="Which Letter Insert" KILL DA D ^DIR KILL DIR

 ;D EN^VALM2(XQORNOD(0),"OS") ;this list man call allows user to select an entry in list

 ;I '$D(VALMY) W !,"No letter insert selected." Q

 I $D(DIRUT) D EXIT Q

 S BDMP=+Y I 'BDMP K BDMP,VALMY,XQORNOD W !,"No INSERT selected." Q

 S (X,Y)=0 F  S X=$O(BDMLETI("IDX",X)) Q:X'=+X!(BDMIEN)  I $O(BDMLETI("IDX",X,0))=BDMP S Y=$O(BDMLETI("IDX",X,0)),BDMIEN=BDMLETI("IDX",X,Y)

 I '$D(^BDMLETI(BDMIEN,0)) W !,"Not a valid INSERT." K BDMP S BDMIEN=0 Q

 W !!,$P(^BDMLETI(BDMIEN,0),U,1)

 W !

 S X=0 F  S X=$O(^BDMLETI(BDMIEN,3,X)) Q:X'=+X  W !,^BDMLETI(BDMIEN,3,X,0)

 I $O(^BDMLETI(BDMIEN,2,0)) W !!,"Education Text is: ",!

 S X=0 F  S X=$O(^BDMLETI(BDMIEN,2,X)) Q:X'=+X  W !,^BDMLETI(BDMIEN,2,X,0)

 K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR

 D TERM^VALM0

 S VALMBCK="R"

 Q

BDMLEH    ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ; [ 01-FEB-2010 ]

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**1,3,5**;JUN 14, 2007

 +2       ;; ;

EN        ; -- main entry point for BDM LETTER INSERT HELP

 +1        DO EN^VALM("BDM LETTER INSERT HELP")

 +2        QUIT 

 +3       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="General Information about letter inserts."

 +2        QUIT 

 +3       ;

INIT      ; -- init variables and list array

 +1        KILL BDMLELH

 +2        NEW BDMX,BDMC,VALMCNT

 +3        SET BDMC=0

 +4        SET BDMX=0

           FOR 

               SET BDMX=$ORDER(^BDMLETIH(1,1,BDMX))

               IF BDMX'=+BDMX

                   QUIT 

               Begin DoDot:1

 +5                SET BDMC=BDMC+1

                   SET BDMLETH(BDMC,0)=^BDMLETIH(1,1,BDMX,0)

               End DoDot:1

 +6        SET VALMCNT=BDMC

 +7        QUIT 

 +8       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

INDITEM   ;EP - called from protocol

 +1       ;get item

 +2       ;display text

 +3        DO TERM^VALM0

 +4       ;give me full control of screen

           DO FULL^VALM1

 +5        SET VALMCNT=BDMLETIC

 +6        NEW BDMIEN,BDMP

 +7        SET BDMIEN=0

 +8        SET DIR(0)="N^1:"_BDMLETIC_":0"

           SET DIR("A")="Which Letter Insert"

           KILL DA

           DO ^DIR

           KILL DIR

 +9       ;D EN^VALM2(XQORNOD(0),"OS") ;this list man call allows user to select an entry in list

 +10      ;I '$D(VALMY) W !,"No letter insert selected." Q

 +11       IF $DATA(DIRUT)

               DO EXIT

               QUIT 

 +12       SET BDMP=+Y

           IF 'BDMP

               KILL BDMP,VALMY,XQORNOD

               WRITE !,"No INSERT selected."

               QUIT 

 +13       SET (X,Y)=0

           FOR 

               SET X=$ORDER(BDMLETI("IDX",X))

               IF X'=+X!(BDMIEN)

                   QUIT 

               IF $ORDER(BDMLETI("IDX",X,0))=BDMP

                   SET Y=$ORDER(BDMLETI("IDX",X,0))

                   SET BDMIEN=BDMLETI("IDX",X,Y)

 +14       IF '$DATA(^BDMLETI(BDMIEN,0))

               WRITE !,"Not a valid INSERT."

               KILL BDMP

               SET BDMIEN=0

               QUIT 

 +15       WRITE !!,$PIECE(^BDMLETI(BDMIEN,0),U,1)

 +16       WRITE !

 +17       SET X=0

           FOR 

               SET X=$ORDER(^BDMLETI(BDMIEN,3,X))

               IF X'=+X

                   QUIT 

               WRITE !,^BDMLETI(BDMIEN,3,X,0)

 +18       IF $ORDER(^BDMLETI(BDMIEN,2,0))

               WRITE !!,"Education Text is: ",!

 +19       SET X=0

           FOR 

               SET X=$ORDER(^BDMLETI(BDMIEN,2,X))

               IF X'=+X

                   QUIT 

               WRITE !,^BDMLETI(BDMIEN,2,X,0)

 +20       KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press enter to continue"

           DO ^DIR

           KILL DIR

 +21       DO TERM^VALM0

 +22       SET VALMBCK="R"

 +23       QUIT