BSDCLET.m

BSDCLET ;cmi/anch/maw - BSD Print Letters by Patient 2/20/2007 1:06:40 PM

 ;;5.3;PIMS;**1007**;FEB 27, 2007

 ;

 ;

 ;cmi/anch/maw 2/20/2007 PATCH 1007 item 1007.14

 ;

 ;

MAIN ;-- main driver

 D LTR

 I '$G(BSDLET) D XIT Q

 D PAT

 I $O(VAUTN(""))="" D  Q  ;cmi/anch/maw 8/14/2007 changed from $D to stop if no patient selected

 . W !,"You must select a patient, quitting" H 3

 . D XIT

 D PRT

 D XIT

 Q

 ;

LTR ;-- select the letter

 K DIC,X,Y

 S DIC=407.5

 S DIC(0)="AEQMZ"

 D ^DIC

 Q:'$G(Y)

 S BSDLET=+Y

 Q

 ;

PAT ;-- select the patients

 S VAUTNI=1

 S VAUTNALL=1

 D PATIENT^VAUTOMA

 Q

 ;

PRT ;-- print the letter

 D ZIS^DGUTQ

 Q:POP

 U IO

 S SDLET=BSDLET

 S SDFORM=0

 N BSDDA

 S BSDDA=0 F  S BSDDA=$O(VAUTN(BSDDA)) Q:BSDDA=""  D

 . S A=$G(VAUTN(BSDDA))

 . D PRT^BSDLT

 . D REST^BSDLT

 D CLOSE^DGUTQ

 Q

 ;

XIT ;-- clean up the variables

 K VAUTNI,VAUTNALL,SDLET,BSDLET,SDFORM,VAUTN

 D KVA^VADPT,KILL^AUPNPAT

 Q

 ;

BSDCLET   ;cmi/anch/maw - BSD Print Letters by Patient 2/20/2007 1:06:40 PM

 +1       ;;5.3;PIMS;**1007**;FEB 27, 2007

 +2       ;

 +3       ;

 +4       ;cmi/anch/maw 2/20/2007 PATCH 1007 item 1007.14

 +5       ;

 +6       ;

MAIN      ;-- main driver

 +1        DO LTR

 +2        IF '$GET(BSDLET)

               DO XIT

               QUIT 

 +3        DO PAT

 +4       ;cmi/anch/maw 8/14/2007 changed from $D to stop if no patient selected

           IF $ORDER(VAUTN(""))=""

               Begin DoDot:1

 +5                WRITE !,"You must select a patient, quitting"

                   HANG 3

 +6                DO XIT

               End DoDot:1

               QUIT 

 +7        DO PRT

 +8        DO XIT

 +9        QUIT 

 +10      ;

LTR       ;-- select the letter

 +1        KILL DIC,X,Y

 +2        SET DIC=407.5

 +3        SET DIC(0)="AEQMZ"

 +4        DO ^DIC

 +5        IF '$GET(Y)

               QUIT 

 +6        SET BSDLET=+Y

 +7        QUIT 

 +8       ;

PAT       ;-- select the patients

 +1        SET VAUTNI=1

 +2        SET VAUTNALL=1

 +3        DO PATIENT^VAUTOMA

 +4        QUIT 

 +5       ;

PRT       ;-- print the letter

 +1        DO ZIS^DGUTQ

 +2        IF POP

               QUIT 

 +3        USE IO

 +4        SET SDLET=BSDLET

 +5        SET SDFORM=0

 +6        NEW BSDDA

 +7        SET BSDDA=0

           FOR 

               SET BSDDA=$ORDER(VAUTN(BSDDA))

               IF BSDDA=""

                   QUIT 

               Begin DoDot:1

 +8                SET A=$GET(VAUTN(BSDDA))

 +9                DO PRT^BSDLT

 +10               DO REST^BSDLT

               End DoDot:1

 +11       DO CLOSE^DGUTQ

 +12       QUIT 

 +13      ;

XIT       ;-- clean up the variables

 +1        KILL VAUTNI,VAUTNALL,SDLET,BSDLET,SDFORM,VAUTN

 +2        DO KVA^VADPT

           DO KILL^AUPNPAT

 +3        QUIT 

 +4       ;