VAQDIS41 ;ALB/JRP/JFP - PRINT PROFILES;28APR92
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
PRINT(LONGFORM) ;PRINT PDX PHARMACY INFORMATION
;INPUT :
; LONGFORM - 1 = Print profile in long format (default)
; 0 = Print profile in short format
;
;CHECK PARAMETERS
S VAQPOP=0
S:($G(LONGFORM)="") LONGFORM=1
;
; -- PRINT HEADER
S VAQLN=$$REPEAT^VAQUTL1("-",79)
S VAQCTR="< "_$S($P(VAQSEGND,"^",1)'="":$P(VAQSEGND,"^",1),1:"Segment Description Missing")_" >"
S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
D TMP^VAQDIS20,BLANK^VAQDIS20
K VAQLN,VAQCTR
;
; -- PRINT DEMOGRAPHICS
D DEMOG^VAQDIS42,BLANK^VAQDIS20
; -- PHARMACY DATA EXIST
I '$D(@XTRCT@("VALUE",52,.01,0)) D NOPHAR QUIT 0
I $G(@XTRCT@("VALUE",52,.01,0))="" D NOPHAR QUIT 0
; -- PRINT COLUMN HEADINGS FOR SHORT FORMAT
I ('LONGFORM) D
.S X=$$SETSTR^VALM1("RX#","",1,7)
.S X=$$SETSTR^VALM1("DRUG",X,8,37)
.S X=$$SETSTR^VALM1("STAT",X,45,5)
.S X=$$SETSTR^VALM1("QTY",X,51,5)
.S X=$$SETSTR^VALM1("ISSUED",X,56,10)
.S X=$$SETSTR^VALM1("LAST FILL",X,66,10)
.S X=$$SETSTR^VALM1("REM",X,76,3)
.D TMP^VAQDIS20
.D SHORT^VAQDIS43
; -- PRINT LONG FORM
I (LONGFORM) D
.D LONG^VAQDIS43
I 'VAQPOP D
.S VAQLN=$$REPEAT^VAQUTL1(" ",79)
.S VAQCTR="***** The above is PDX Pharmacy Information and should be used accordingly *****"
.S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D TMP^VAQDIS20
; -- Clean up
K VAQLN,VAQCTR,VAQPOP,LONGFORM
QUIT 0
NOPHAR ; -- No pharmacy data
S VAQMSG="*** There is no Pharmacy Information..."
S X=$$SETSTR^VALM1(VAQMSG,"",1,79)
D TMP^VAQDIS20
K VAQMSG
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS41 1653 printed Nov 22, 2024@17:35:39 Page 2
VAQDIS41 ;ALB/JRP/JFP - PRINT PROFILES;28APR92
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
PRINT(LONGFORM) ;PRINT PDX PHARMACY INFORMATION
+1 ;INPUT :
+2 ; LONGFORM - 1 = Print profile in long format (default)
+3 ; 0 = Print profile in short format
+4 ;
+5 ;CHECK PARAMETERS
+6 SET VAQPOP=0
+7 if ($GET(LONGFORM)="")
SET LONGFORM=1
+8 ;
+9 ; -- PRINT HEADER
+10 SET VAQLN=$$REPEAT^VAQUTL1("-",79)
+11 SET VAQCTR="< "_$SELECT($PIECE(VAQSEGND,"^",1)'="":$PIECE(VAQSEGND,"^",1),1:"Segment Description Missing")_" >"
+12 SET X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
+13 DO TMP^VAQDIS20
DO BLANK^VAQDIS20
+14 KILL VAQLN,VAQCTR
+15 ;
+16 ; -- PRINT DEMOGRAPHICS
+17 DO DEMOG^VAQDIS42
DO BLANK^VAQDIS20
+18 ; -- PHARMACY DATA EXIST
+19 IF '$DATA(@XTRCT@("VALUE",52,.01,0))
DO NOPHAR
QUIT 0
+20 IF $GET(@XTRCT@("VALUE",52,.01,0))=""
DO NOPHAR
QUIT 0
+21 ; -- PRINT COLUMN HEADINGS FOR SHORT FORMAT
+22 IF ('LONGFORM)
Begin DoDot:1
+23 SET X=$$SETSTR^VALM1("RX#","",1,7)
+24 SET X=$$SETSTR^VALM1("DRUG",X,8,37)
+25 SET X=$$SETSTR^VALM1("STAT",X,45,5)
+26 SET X=$$SETSTR^VALM1("QTY",X,51,5)
+27 SET X=$$SETSTR^VALM1("ISSUED",X,56,10)
+28 SET X=$$SETSTR^VALM1("LAST FILL",X,66,10)
+29 SET X=$$SETSTR^VALM1("REM",X,76,3)
+30 DO TMP^VAQDIS20
+31 DO SHORT^VAQDIS43
End DoDot:1
+32 ; -- PRINT LONG FORM
+33 IF (LONGFORM)
Begin DoDot:1
+34 DO LONG^VAQDIS43
End DoDot:1
+1 IF 'VAQPOP
Begin DoDot:1
+2 SET VAQLN=$$REPEAT^VAQUTL1(" ",79)
+3 SET VAQCTR="***** The above is PDX Pharmacy Information and should be used accordingly *****"
+4 SET X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
DO TMP^VAQDIS20
End DoDot:1
+5 ; -- Clean up
+6 KILL VAQLN,VAQCTR,VAQPOP,LONGFORM
+7 QUIT 0
NOPHAR ; -- No pharmacy data
+1 SET VAQMSG="*** There is no Pharmacy Information..."
+2 SET X=$$SETSTR^VALM1(VAQMSG,"",1,79)
+3 DO TMP^VAQDIS20
+4 KILL VAQMSG
+5 QUIT
+6 ;
