BSDIMPL.m

BSDIMPL ; IHS/ANMC/LJF - SCHEDULING IMPLEMENTATION ;  [ 01/22/2004  1:11 PM ]

 ;;5.3;PIMS;;APR 26, 2002

 ;

 Q

 ;

EN ;EP; called by installer from programmer mode

 ; runs through items on Scheduling Supervisor Menu after install

 ;    while users still off system

 ;

ACTION ; -- choose which action to perform

 NEW BDGACT,BDGA,X,Y,BDGQUIT

 W !!

 F X=1:1:4 S BDGA(X)=$J(X,3)_". "_$P($T(RPT+X),";;",2)

 S Y=$$READ^BDGF("NO^1:4","Choose Implementation Action","","","",.BDGA)

 Q:'Y  I Y=4 S XQH="BSD IMPLEMENT" D EN^XQH G ACTION

 S BDGACT=$P($T(RPT+Y),";;",3) X BDGACT D EN^XBVK("VALM")

 D ACTION

 Q

 ;

RPT ;;

 ;;Edit Scheduling Parameters;;D ^BSDPARM;;

 ;;Update Appointment Slip Letter;;D LETTER^BSDIMPL;;

 ;;View Scheduling Event Driver;;D ^BSDSYS1;;

 ;;On-line Help;;D ^BSDHELP;;

 ;

LETTER ;EP; selects new Appointment Slip Letter for editing

 NEW DIE,DA,DR

 S DA=$O(^VA(407.5,"B","APPOINTMENT SLIP",0))

 I 'DA W !!,"No generic Appointment Slip letter on file" D PAUSE^BDGF Q

 ;

 W !!,"NAME: APPOINMENT SLIP",!

 S DIE=407.5,DR="1:9999999.99" D ^DIE

 Q

BSDIMPL   ; IHS/ANMC/LJF - SCHEDULING IMPLEMENTATION ;  [ 01/22/2004  1:11 PM ]

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

 +2       ;

 +3        QUIT 

 +4       ;

EN        ;EP; called by installer from programmer mode

 +1       ; runs through items on Scheduling Supervisor Menu after install

 +2       ;    while users still off system

 +3       ;

ACTION    ; -- choose which action to perform

 +1        NEW BDGACT,BDGA,X,Y,BDGQUIT

 +2        WRITE !!

 +3        FOR X=1:1:4

               SET BDGA(X)=$JUSTIFY(X,3)_". "_$PIECE($TEXT(RPT+X),";;",2)

 +4        SET Y=$$READ^BDGF("NO^1:4","Choose Implementation Action","","","",.BDGA)

 +5        IF 'Y

               QUIT 

           IF Y=4

               SET XQH="BSD IMPLEMENT"

               DO EN^XQH

               GOTO ACTION

 +6        SET BDGACT=$PIECE($TEXT(RPT+Y),";;",3)

           XECUTE BDGACT

           DO EN^XBVK("VALM")

 +7        DO ACTION

 +8        QUIT 

 +9       ;

RPT       ;;

 +1       ;;Edit Scheduling Parameters;;D ^BSDPARM;;

 +2       ;;Update Appointment Slip Letter;;D LETTER^BSDIMPL;;

 +3       ;;View Scheduling Event Driver;;D ^BSDSYS1;;

 +4       ;;On-line Help;;D ^BSDHELP;;

 +5       ;

LETTER    ;EP; selects new Appointment Slip Letter for editing

 +1        NEW DIE,DA,DR

 +2        SET DA=$ORDER(^VA(407.5,"B","APPOINTMENT SLIP",0))

 +3        IF 'DA

               WRITE !!,"No generic Appointment Slip letter on file"

               DO PAUSE^BDGF

               QUIT 

 +4       ;

 +5        WRITE !!,"NAME: APPOINMENT SLIP",!

 +6        SET DIE=407.5

           SET DR="1:9999999.99"

           DO ^DIE

 +7        QUIT