- SDWLIFT7 ; bp-oifo/og ; Print reports ; Compiled April 11, 2005 16:10:09
- ;;5.3;Scheduling;**415,1015**;AUG 13 1993;Build 21
- ;
- ;
- ;******************************************************************
- ; CHANGE LOG
- ;
- ; DATE PATCH DESCRIPTION
- ; ---- ----- -----------
- ;
- ;
- ; Print coversheet, dialog.
- D DIALOG("EN1^"_$T(+0),"SDWL TRANSFER COVERSHEET")
- S VALMBCK="R"
- Q
- REQS ; All transfer requests
- N SDWLSPS ; Required as this is called from a menu option.
- S SDWLSPS=$J("",80)
- D DIALOG("EN2^"_$T(+0),"SDWL TRANSFER PRINT REQUESTS")
- Q
- HEAD ; Write header.
- S SDWLLINE=3,SDWLPAGE=SDWLPAGE+1
- W !?80-$L(SDWLTTL)\2,SDWLTTL,?75-$L(SDWLPAGE),"PAGE ",SDWLPAGE,!
- Q
- EN1 ; Print coversheet.
- N SDWLTTL,SDWLINFO,SDWLPAGE,SDWLLINE,SDWLI
- D GETINFO^SDWLIFT6(.SDWLINFO)
- S SDWLTTL="SDWL TRANSFER - COVERSHEET",SDWLPAGE=0
- D HEAD
- F SDWLI=1:1:SDWLINFO(0) D
- .S SDWLLINE=SDWLLINE+1
- .I SDWLLINE+3>IOSL D HEAD
- .W !,SDWLINFO(SDWLI,0)
- .Q
- Q
- EN2 ; Print requests
- N SDWLINFO,SDWLTTL,SDWLPAGE,SDWLLINE,SDWLI
- D GETDATA^SDWLIFT5(.SDWLINFO,1)
- S SDWLTTL="SDWL TRANSFER - TRANSFER REQUESTS",SDWLPAGE=0
- D HEAD
- F SDWLI=1:1:SDWLINFO(0) D
- .I SDWLLINE+8>IOSL D HEAD
- .W !,"Name: ",$E($P(SDWLINFO(SDWLI,0),U)_SDWLSPS,1,32)
- .W "Sex: ",$P(SDWLINFO(SDWLI,0),U,8)
- .W " SSN: ",$E($P(SDWLINFO(SDWLI,0),U,2)_SDWLSPS,1,14)
- .W !,"Wait List Type: ",$P(SDWLINFO(SDWLI,0),U,6)
- .W " : ",$P(SDWLINFO(SDWLI,0),U,7)
- .W !,"Status: ",$E($P(SDWLINFO(SDWLI,0),U,4)_SDWLSPS,1,14)
- .W "Transmission time: ",$P(SDWLINFO(SDWLI,0),U,9)
- .W !,"Requestor: ",$P(SDWLINFO(SDWLI,0),U,10),!
- .S SDWLLINE=SDWLLINE+5
- .Q
- Q
- DIALOG(ZTRTN,SDWLDESC) ; Required variable - SDWLIFTN: SDWL Transfer id.
- N DIE,DA,DR
- K %ZIS,IOP,POP,ZTSK,SDWLIO
- S ZTDESC=SDWLDESC
- D FULL^VALM1
- S SDWLIO=ION,%ZIS="Q"
- D ^%ZIS
- K %ZIS
- S IOM=80
- I POP D ; Do-dots preserve $T
- .S IOP=SDWLIO
- .D ^%ZIS
- .K IOP,SDWLIO
- .W !,"Please try later!"
- .Q
- E D I $G(SDWLDESC)="SDWL TRANSFER COVERSHEET" S DIE="^SDWL(409.36,",DA=SDWLIFTN,DR=".3///Y" D ^DIE
- .K SDDIO
- .I '$D(IO("Q")) D @ZTRTN Q
- .K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
- .S ZTDTH=$H S:$D(SDWLIFTN) ZTSAVE("SDWLIFTN")=SDWLIFTN,ZTSAVE("SDWLSPS")=SDWLSPS
- .D ^%ZTLOAD W:$D(ZTSK) !,"Report is queued to print !!" K ZTSK
- .Q
- END ; Tidy up.
- W ! D ^%ZISC
- Q
- SDWLIFT7 ; bp-oifo/og ; Print reports ; Compiled April 11, 2005 16:10:09
- +1 ;;5.3;Scheduling;**415,1015**;AUG 13 1993;Build 21
- +2 ;
- +3 ;
- +4 ;******************************************************************
- +5 ; CHANGE LOG
- +6 ;
- +7 ; DATE PATCH DESCRIPTION
- +8 ; ---- ----- -----------
- +9 ;
- +10 ;
- +11 ; Print coversheet, dialog.
- +12 DO DIALOG("EN1^"_$TEXT(+0),"SDWL TRANSFER COVERSHEET")
- +13 SET VALMBCK="R"
- +14 QUIT
- REQS ; All transfer requests
- +1 ; Required as this is called from a menu option.
- NEW SDWLSPS
- +2 SET SDWLSPS=$JUSTIFY("",80)
- +3 DO DIALOG("EN2^"_$TEXT(+0),"SDWL TRANSFER PRINT REQUESTS")
- +4 QUIT
- HEAD ; Write header.
- +1 SET SDWLLINE=3
- SET SDWLPAGE=SDWLPAGE+1
- +2 WRITE !?80-$LENGTH(SDWLTTL)\2,SDWLTTL,?75-$LENGTH(SDWLPAGE),"PAGE ",SDWLPAGE,!
- +3 QUIT
- EN1 ; Print coversheet.
- +1 NEW SDWLTTL,SDWLINFO,SDWLPAGE,SDWLLINE,SDWLI
- +2 DO GETINFO^SDWLIFT6(.SDWLINFO)
- +3 SET SDWLTTL="SDWL TRANSFER - COVERSHEET"
- SET SDWLPAGE=0
- +4 DO HEAD
- +5 FOR SDWLI=1:1:SDWLINFO(0)
- Begin DoDot:1
- +6 SET SDWLLINE=SDWLLINE+1
- +7 IF SDWLLINE+3>IOSL
- DO HEAD
- +8 WRITE !,SDWLINFO(SDWLI,0)
- +9 QUIT
- End DoDot:1
- +10 QUIT
- EN2 ; Print requests
- +1 NEW SDWLINFO,SDWLTTL,SDWLPAGE,SDWLLINE,SDWLI
- +2 DO GETDATA^SDWLIFT5(.SDWLINFO,1)
- +3 SET SDWLTTL="SDWL TRANSFER - TRANSFER REQUESTS"
- SET SDWLPAGE=0
- +4 DO HEAD
- +5 FOR SDWLI=1:1:SDWLINFO(0)
- Begin DoDot:1
- +6 IF SDWLLINE+8>IOSL
- DO HEAD
- +7 WRITE !,"Name: ",$EXTRACT($PIECE(SDWLINFO(SDWLI,0),U)_SDWLSPS,1,32)
- +8 WRITE "Sex: ",$PIECE(SDWLINFO(SDWLI,0),U,8)
- +9 WRITE " SSN: ",$EXTRACT($PIECE(SDWLINFO(SDWLI,0),U,2)_SDWLSPS,1,14)
- +10 WRITE !,"Wait List Type: ",$PIECE(SDWLINFO(SDWLI,0),U,6)
- +11 WRITE " : ",$PIECE(SDWLINFO(SDWLI,0),U,7)
- +12 WRITE !,"Status: ",$EXTRACT($PIECE(SDWLINFO(SDWLI,0),U,4)_SDWLSPS,1,14)
- +13 WRITE "Transmission time: ",$PIECE(SDWLINFO(SDWLI,0),U,9)
- +14 WRITE !,"Requestor: ",$PIECE(SDWLINFO(SDWLI,0),U,10),!
- +15 SET SDWLLINE=SDWLLINE+5
- +16 QUIT
- End DoDot:1
- +17 QUIT
- DIALOG(ZTRTN,SDWLDESC) ; Required variable - SDWLIFTN: SDWL Transfer id.
- +1 NEW DIE,DA,DR
- +2 KILL %ZIS,IOP,POP,ZTSK,SDWLIO
- +3 SET ZTDESC=SDWLDESC
- +4 DO FULL^VALM1
- +5 SET SDWLIO=ION
- SET %ZIS="Q"
- +6 DO ^%ZIS
- +7 KILL %ZIS
- +8 SET IOM=80
- +9 ; Do-dots preserve $T
- IF POP
- Begin DoDot:1
- +10 SET IOP=SDWLIO
- +11 DO ^%ZIS
- +12 KILL IOP,SDWLIO
- +13 WRITE !,"Please try later!"
- +14 QUIT
- End DoDot:1
- +15 IF '$TEST
- Begin DoDot:1
- +16 KILL SDDIO
- +17 IF '$DATA(IO("Q"))
- DO @ZTRTN
- QUIT
- +18 KILL IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
- +19 SET ZTDTH=$HOROLOG
- IF $DATA(SDWLIFTN)
- SET ZTSAVE("SDWLIFTN")=SDWLIFTN
- SET ZTSAVE("SDWLSPS")=SDWLSPS
- +20 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"Report is queued to print !!"
- KILL ZTSK
- +21 QUIT
- End DoDot:1
- IF $GET(SDWLDESC)="SDWL TRANSFER COVERSHEET"
- SET DIE="^SDWL(409.36,"
- SET DA=SDWLIFTN
- SET DR=".3///Y"
- DO ^DIE
- END ; Tidy up.
- +1 WRITE !
- DO ^%ZISC
- +2 QUIT
