VPSPRINT ;SLOIFO/BT - Common APIs used for VPS Printing;07/18/14 15:08
;;1.0;VA POINT OF SERVICE (KIOSKS);**4**;Jul 18,2014;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External Reference DBIA#
; ------------------------
; #2171 - $$LKUP^XUAF4 - Supported
; #3771 - DEVICE^XUDHGUI - Supported
; #2701 - MPIF001 call - Supported
; #5888 - RPCVIC^DPTLK - Controlled Sub
; #10114 - DEVICE file ^%ZIS(1) (Supported)
QUIT
;
GETDFN(VPSTYP,VPSNUM) ;Return DFN given Patient ID Type and Value
;INPUT
; VPSTYP Patients ID Type - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
; VPSNUM Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
;RETURN
; DFN (successful) OR
; "-1^ERROR" (error/not found)
;
N CM S CM=","
;
QUIT:$G(VPSTYP)="" "-1^TYPE IS REQUIRED (VALID TYPE: SSN, DFN, ICN OR VIC/CAC)"
QUIT:'$F(",SSN,DFN,ICN,VIC/CAC,",CM_VPSTYP_CM) "-1^INVALID TYPE (VALID TYPE: SSN, DFN, ICN OR VIC/CAC)"
QUIT:$G(VPSNUM)="" "-1^SSN, DFN, ICN OR VIC/CAC IS REQUIRED"
;
N DFN
;
I VPSTYP="SSN" D
. S DFN=$O(^DPT("SSN",VPSNUM,0))
. I +DFN'>0 S DFN="-1"_U_"NO PATIENT FOUND WITH SSN: "_VPSNUM
I VPSTYP="DFN" D
. S DFN=VPSNUM
. I '$D(^DPT(DFN)) S DFN="-1"_U_"NO PATIENT FOUND WITH DFN: "_VPSNUM
I VPSTYP="VIC/CAC" D
. D RPCVIC^DPTLK(.DFN,VPSNUM) ; get DFN given VIC/CAC number - IA 5888
. S:DFN=-1 DFN="-1^NO DFN FOR VIC/CAC NUMBER"
I VPSTYP="ICN" D
. S DFN=$$GETDFN^MPIF001(VPSNUM) ; get DFN given ICN in the Patient file - IA 2701
;
QUIT DFN
;
DEVICE(VPSDEV,FROM,DIR) ; RPC: VPS GET PRINTERS
; -- Return up to 20 entries from the Device file based on Input criteria
; INPUT
; FROM : List all printers start from (text to $O from)
; B (all device with name start *WITH* B)
; B* (all device with name start *FROM* B)
; DIR : Ascending order (1) or Descending order (-1) ($O direction)
; OUTPUT
; VPSDEV : By reference local array contains VistA printers based on input criteria
; SYNTAX
; Found : VPSDEV(0) = 1
; VPSDEV(1..n)=IEN^Name^DisplayName^Location^RMar^PLen
;
; Not Found : VPSDEV(0) = -1^No printers on file
;
K VPSDEV
S FROM=$G(FROM)
S DIR=$G(DIR,1)
D DEVICE^XUDHGUI(.VPSDEV,FROM,DIR)
I $D(VPSDEV) S VPSDEV(0)=1 ; At least there is one device in the list
I '$D(VPSDEV) S VPSDEV(0)="-1^No printers on file"
QUIT
;
DEVEXIST(DEVNAME) ;check if DEVNAME exists on file
; Returns 1 if found, otherwise returns -1^err message
QUIT:$G(DEVNAME)="" "-1^NO DEVICE SENT"
N DIC S DIC="^%ZIS(1,"
N X S X=DEVNAME
N Y D ^DIC
QUIT:$P(Y,U,2)'=DEVNAME "-1"_U_"DEVICE "_DEVNAME_" NOT FOUND"
QUIT 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSPRINT 2791 printed Apr 09, 2024@21:45:51 Page 2
VPSPRINT ;SLOIFO/BT - Common APIs used for VPS Printing;07/18/14 15:08
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**4**;Jul 18,2014;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External Reference DBIA#
+5 ; ------------------------
+6 ; #2171 - $$LKUP^XUAF4 - Supported
+7 ; #3771 - DEVICE^XUDHGUI - Supported
+8 ; #2701 - MPIF001 call - Supported
+9 ; #5888 - RPCVIC^DPTLK - Controlled Sub
+10 ; #10114 - DEVICE file ^%ZIS(1) (Supported)
+11 QUIT
+12 ;
GETDFN(VPSTYP,VPSNUM) ;Return DFN given Patient ID Type and Value
+1 ;INPUT
+2 ; VPSTYP Patients ID Type - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
+3 ; VPSNUM Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
+4 ;RETURN
+5 ; DFN (successful) OR
+6 ; "-1^ERROR" (error/not found)
+7 ;
+8 NEW CM
SET CM=","
+9 ;
+10 if $GET(VPSTYP)=""
QUIT "-1^TYPE IS REQUIRED (VALID TYPE: SSN, DFN, ICN OR VIC/CAC)"
+11 if '$FIND(",SSN,DFN,ICN,VIC/CAC,",CM_VPSTYP_CM)
QUIT "-1^INVALID TYPE (VALID TYPE: SSN, DFN, ICN OR VIC/CAC)"
+12 if $GET(VPSNUM)=""
QUIT "-1^SSN, DFN, ICN OR VIC/CAC IS REQUIRED"
+13 ;
+14 NEW DFN
+15 ;
+16 IF VPSTYP="SSN"
Begin DoDot:1
+17 SET DFN=$ORDER(^DPT("SSN",VPSNUM,0))
+18 IF +DFN'>0
SET DFN="-1"_U_"NO PATIENT FOUND WITH SSN: "_VPSNUM
End DoDot:1
+19 IF VPSTYP="DFN"
Begin DoDot:1
+20 SET DFN=VPSNUM
+21 IF '$DATA(^DPT(DFN))
SET DFN="-1"_U_"NO PATIENT FOUND WITH DFN: "_VPSNUM
End DoDot:1
+22 IF VPSTYP="VIC/CAC"
Begin DoDot:1
+23 ; get DFN given VIC/CAC number - IA 5888
DO RPCVIC^DPTLK(.DFN,VPSNUM)
+24 if DFN=-1
SET DFN="-1^NO DFN FOR VIC/CAC NUMBER"
End DoDot:1
+25 IF VPSTYP="ICN"
Begin DoDot:1
+26 ; get DFN given ICN in the Patient file - IA 2701
SET DFN=$$GETDFN^MPIF001(VPSNUM)
End DoDot:1
+27 ;
+28 QUIT DFN
+29 ;
DEVICE(VPSDEV,FROM,DIR) ; RPC: VPS GET PRINTERS
+1 ; -- Return up to 20 entries from the Device file based on Input criteria
+2 ; INPUT
+3 ; FROM : List all printers start from (text to $O from)
+4 ; B (all device with name start *WITH* B)
+5 ; B* (all device with name start *FROM* B)
+6 ; DIR : Ascending order (1) or Descending order (-1) ($O direction)
+7 ; OUTPUT
+8 ; VPSDEV : By reference local array contains VistA printers based on input criteria
+9 ; SYNTAX
+10 ; Found : VPSDEV(0) = 1
+11 ; VPSDEV(1..n)=IEN^Name^DisplayName^Location^RMar^PLen
+12 ;
+13 ; Not Found : VPSDEV(0) = -1^No printers on file
+14 ;
+15 KILL VPSDEV
+16 SET FROM=$GET(FROM)
+17 SET DIR=$GET(DIR,1)
+18 DO DEVICE^XUDHGUI(.VPSDEV,FROM,DIR)
+19 ; At least there is one device in the list
IF $DATA(VPSDEV)
SET VPSDEV(0)=1
+20 IF '$DATA(VPSDEV)
SET VPSDEV(0)="-1^No printers on file"
+21 QUIT
+22 ;
DEVEXIST(DEVNAME) ;check if DEVNAME exists on file
+1 ; Returns 1 if found, otherwise returns -1^err message
+2 if $GET(DEVNAME)=""
QUIT "-1^NO DEVICE SENT"
+3 NEW DIC
SET DIC="^%ZIS(1,"
+4 NEW X
SET X=DEVNAME
+5 NEW Y
DO ^DIC
+6 if $PIECE(Y,U,2)'=DEVNAME
QUIT "-1"_U_"DEVICE "_DEVNAME_" NOT FOUND"
+7 QUIT 1
