- RAWORK ;HISC/CAH,FPT,GJC AISC/TMP,RMO-Rad/Nuc Med Worksheet print (132 Char. Format) ;9/5/95 12:39
- ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- W !!,?5,"*** RADIOLOGY/NUCLEAR MEDICINE WORKSHEETS ***",!!!
- ASKNUM R !!,"Enter the number of worksheets needed: ",X:DTIME G Q:'$T!(X="")!(X["^") I +X'>0 W:X'["?" *7 W !!?3,"Enter the number of worksheets to be printed." G ASKNUM
- S RANUM=+X,RADIV=$S('$D(RAMDIV):"",$D(^DIC(4,RAMDIV,0)):$P(^(0),"^"),1:"")
- W !!,"NOTE: This output should be sent to a printer that supports 132 columns.",!
- S ZTSAVE("RANUM")="",ZTSAVE("RADIV")="",ZTRTN="START^RAWORK",RAZIS=1 D ZIS^RAUTL G Q:RAPOP
- START U IO S RASKIP="!,""| |"",?64,""|"",?131,""|""",RALINE="",$P(RALINE,"_",133)=""
- S RASKIP1="!,""|"",?21,""|"",?83,""|"",?99,""|"",?115,""|"",?131,""|"""
- F J=1:1:+RANUM D RAREP
- Q K DUOUT,I,I1,I2,J,POP,RALIM,RALINE,RAMES,RANUM,RAPOP,RASKIP,RASKIP1,RAZIS,RADIV,X,ZTDESC,ZTRTN,ZTSAVE
- D CLOSE^RAUTL
- Q
- ;
- RAREP W:J>1 @IOF W !,?56,"RADIOLOGY/NUCLEAR MEDICINE WORKSHEET",! W RALINE
- W @RASKIP,!,"| |",?9,"VAMC ",RADIV,?64,"|",?131,"|",@RASKIP,!,"| | DATE ",$E(RALINE,1,32),?46,"AGE ",$E(RALINE,1,11),?64,"|",?75,"TIME: ",$E(RALINE,1,20),?131,"|",@RASKIP
- W !,"| | SSN ",$E(RALINE,1,32),?46,"TCH ",$E(RALINE,1,11),?64,"|",?75,"LAST EXAM: ",$E(RALINE,1,15),?131,"|",@RASKIP,!,"| | NAME ",$E(RALINE,1,32),?64,"|",?75,"WARD OR OTHER: ",$E(RALINE,1,11),?131,"|"
- F I=1:1:2 W @RASKIP
- W !,"| |",$E(RALINE,1,60),"|",?131,"|",!,"|",?131,"|"
- W !,"|",?131,"|",!,"!",?9,"AMIS",?21,"|",?47,"DESCRIPTION",?83,"|",?89,"TECH",?99,"|",?105,"DIAG.",?115,"|",?121,"M.D.",?131,"|"
- F I1=1:1:10 D LINE1 F I2=1:1:3 W @RASKIP1
- D LINE1 W !,?120,"__________",!,?100,"DATA ENTRY CLERK: | |",!,?119,"|__________|"
- Q
- LINE1 W !,"|",$E(RALINE,1,20),"|",$E(RALINE,1,61),"|",$E(RALINE,1,15),"|",$E(RALINE,1,15),"|",$E(RALINE,1,15),"|" Q
- ;
- PCE() ;Switch to turn on/off the PCE API vs the SDACS credit interface
- Q 1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAWORK 1972 printed Feb 19, 2025@00:07:03 Page 2
- RAWORK ;HISC/CAH,FPT,GJC AISC/TMP,RMO-Rad/Nuc Med Worksheet print (132 Char. Format) ;9/5/95 12:39
- +1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- +2 WRITE !!,?5,"*** RADIOLOGY/NUCLEAR MEDICINE WORKSHEETS ***",!!!
- ASKNUM READ !!,"Enter the number of worksheets needed: ",X:DTIME
- if '$TEST!(X="")!(X["^")
- GOTO Q
- IF +X'>0
- if X'["?"
- WRITE *7
- WRITE !!?3,"Enter the number of worksheets to be printed."
- GOTO ASKNUM
- +1 SET RANUM=+X
- SET RADIV=$SELECT('$DATA(RAMDIV):"",$DATA(^DIC(4,RAMDIV,0)):$PIECE(^(0),"^"),1:"")
- +2 WRITE !!,"NOTE: This output should be sent to a printer that supports 132 columns.",!
- +3 SET ZTSAVE("RANUM")=""
- SET ZTSAVE("RADIV")=""
- SET ZTRTN="START^RAWORK"
- SET RAZIS=1
- DO ZIS^RAUTL
- if RAPOP
- GOTO Q
- START USE IO
- SET RASKIP="!,""| |"",?64,""|"",?131,""|"""
- SET RALINE=""
- SET $PIECE(RALINE,"_",133)=""
- +1 SET RASKIP1="!,""|"",?21,""|"",?83,""|"",?99,""|"",?115,""|"",?131,""|"""
- +2 FOR J=1:1:+RANUM
- DO RAREP
- Q KILL DUOUT,I,I1,I2,J,POP,RALIM,RALINE,RAMES,RANUM,RAPOP,RASKIP,RASKIP1,RAZIS,RADIV,X,ZTDESC,ZTRTN,ZTSAVE
- +1 DO CLOSE^RAUTL
- +2 QUIT
- +3 ;
- RAREP if J>1
- WRITE @IOF
- WRITE !,?56,"RADIOLOGY/NUCLEAR MEDICINE WORKSHEET",!
- WRITE RALINE
- +1 WRITE @RASKIP,!,"| |",?9,"VAMC ",RADIV,?64,"|",?131,"|",@RASKIP,!,"| | DATE ",$EXTRACT(RALINE,1,32),?46,"AGE ",$EXTRACT(RALINE,1,11),?64,"|",?75,"TIME: ",$EXTRACT(RALINE,1,20),?131,"|",@RASKIP
- +2 WRITE !,"| | SSN ",$EXTRACT(RALINE,1,32),?46,"TCH ",$EXTRACT(RALINE,1,11),?64,"|",?75,"LAST EXAM: ",$EXTRACT(RALINE,1,15),?131,"|",@RASKIP,!,"| | NAME ",$EXTRACT(RALINE,1,32),?64,"|",?75,"WARD OR OTHER: ",$EXTRACT(RALINE,1,11),?131,"|"
- +3 FOR I=1:1:2
- WRITE @RASKIP
- +4 WRITE !,"| |",$EXTRACT(RALINE,1,60),"|",?131,"|",!,"|",?131,"|"
- +5 WRITE !,"|",?131,"|",!,"!",?9,"AMIS",?21,"|",?47,"DESCRIPTION",?83,"|",?89,"TECH",?99,"|",?105,"DIAG.",?115,"|",?121,"M.D.",?131,"|"
- +6 FOR I1=1:1:10
- DO LINE1
- FOR I2=1:1:3
- WRITE @RASKIP1
- +7 DO LINE1
- WRITE !,?120,"__________",!,?100,"DATA ENTRY CLERK: | |",!,?119,"|__________|"
- +8 QUIT
- LINE1 WRITE !,"|",$EXTRACT(RALINE,1,20),"|",$EXTRACT(RALINE,1,61),"|",$EXTRACT(RALINE,1,15),"|",$EXTRACT(RALINE,1,15),"|",$EXTRACT(RALINE,1,15),"|"
- QUIT
- +1 ;
- PCE() ;Switch to turn on/off the PCE API vs the SDACS credit interface
- +1 QUIT 1