MAGGTCPR ;WOIFO/GEK - RPC Calls for Patient DHCP Reports ; [ 06/20/2001 08:56 ]
;;3.0;IMAGING;;Mar 01, 2002
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
DGRPD(MAGRPTY,DFN) ;RPC Call to Generate Patient Profile
;
; -- MAGRPTY -- is the name of the global holding the report.
; -- @MAGRPTY@(0)-- if = 0 then error occurred
; -- DFN := Patient File IEN
; the variable MAGRPTY is referenced by CLOSE^MAGGTU5 to load
; the report from the VMS file WS.DAT into the referenced global;
;
S MAGRPTY=$NA(^TMP($J,"WSDAT"))
K @MAGRPTY
S @MAGRPTY@(0)="0^-Cannot Open Workstation Redirection Device"
S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS Q:POP ;Redirect Output Here
U IO
D EN^DGRPD
D:IO'=IO(0) ^%ZISC
S @MAGRPTY@(0)="1^OK"
Q
HSUM(MAGRPTY,MAGGZ) ;RPC Call to Get Health Summary for Patient
; MAGGZ -> DFN ^ HS Type (IEN)
;
N Y,X,GMTSTYP,GMTSTITL
IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTCPR"
E S X="ERRA^MAGGTCPR",@^%ZOSF("TRAP")
S MAGRPTY=$NA(^TMP($J,"WSDAT"))
K @MAGRPTY
S @MAGRPTY@(0)="0^Health Summary Report NOT successful"
S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS Q:POP
S GMTSTYP=$P(MAGGZ,U,2),DFN=$P(MAGGZ,U)
S GMTSTITL=$$GET1^DIQ(142,GMTSTYP,".02","I")
U IO
D SELTYP1^GMTS,EN^GMTS1
D END^GMTS K GMTSEG,GMTSEGI,GMTSEGC ; MOD GEK 5\13\96
D:IO'=IO(0) ^%ZISC
S @MAGRPTY@(0)="1^OK"
Q
HSLIST(MAGRY,ZY) ;RPC Call To do a lookup using LIST^DIC to return
; the List of Health Summary Types for a user to select from.
; MAGRY is the Array to return.
; ZY is NOT USED
; Kernel uses Y, we have to New it because calls to DIC etc
; also use it and change it, and kill it.
N Y,XI,Z,FI,MAGIEN,INFO
N FILE,IENS,FLDS,FLAGS,VAL,NUM,FROM,PART,INDEX,SCR,IDENT,TROOT
S (FILE,IENS,FLDS,FLAGS,VAL,NUM,FROM,PART,INDEX,SCR,IDENT,TROOT)=""
;
; Format
;LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,
; [.]FROM,[.]PART,INDEX,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
;
K ^TMP("DILIST",$J) ; is this necessary ?
K ^TMP("DIERR",$J) ; This is.
S FILE=142,NUM=9000,FROM="",PART="",FLDS="@;.01",INDEX="B"
D LIST^DIC(FILE,IENS,FLDS,FLAGS,NUM,FROM,PART,INDEX,SCR,IDENT,TROOT)
;
I '$D(^TMP("DILIST",$J,2)) D Q
. S MAGRY(XI)="0^NO Health Summary Types Found in VistA"
S INFO=^TMP("DILIST",$J,0)
S XI="" F S XI=$O(^TMP("DILIST",$J,2,XI)) Q:XI="" S MAGIEN=^(XI) D
. S Z=".01",X=^TMP("DILIST",$J,"ID",XI,Z)
. F S Z=$O(^TMP("DILIST",$J,"ID",XI,Z)) Q:Z="" S X=X_" "_^(Z)
. S MAGRY(XI)=X_"^"_MAGIEN
;
S MAGRY(0)=$P(INFO,"^")_U_"Found "_$P(INFO,"^")_" entr"_$S((+INFO=1):"y",1:"ies")
I $P(INFO,"^",3)>0 S MAGRY(0)=MAGRY(0)_" there are more"
Q
DISSUM(MAGRPTY,DFN) ; Discharge summary
S MAGRPTY=$NA(^TMP($J,"WSDAT"))
S @MAGRPTY@(0)="0^NOT YET IMPLEMENTED"
Q
ERRA S @MAGRPTY@(0)="0^"_$$EC^%ZOSV
D @^%ZOSF("ERRTN")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTCPR 3814 printed Apr 09, 2024@21:02:04 Page 2
MAGGTCPR ;WOIFO/GEK - RPC Calls for Patient DHCP Reports ; [ 06/20/2001 08:56 ]
+1 ;;3.0;IMAGING;;Mar 01, 2002
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
DGRPD(MAGRPTY,DFN) ;RPC Call to Generate Patient Profile
+1 ;
+2 ; -- MAGRPTY -- is the name of the global holding the report.
+3 ; -- @MAGRPTY@(0)-- if = 0 then error occurred
+4 ; -- DFN := Patient File IEN
+5 ; the variable MAGRPTY is referenced by CLOSE^MAGGTU5 to load
+6 ; the report from the VMS file WS.DAT into the referenced global;
+7 ;
+8 SET MAGRPTY=$NAME(^TMP($JOB,"WSDAT"))
+9 KILL @MAGRPTY
+10 SET @MAGRPTY@(0)="0^-Cannot Open Workstation Redirection Device"
+11 ;Redirect Output Here
SET IOP="IMAGING WORKSTATION"
SET %ZIS=0
DO ^%ZIS
if POP
QUIT
+12 USE IO
+13 DO EN^DGRPD
+14 if IO'=IO(0)
DO ^%ZISC
+15 SET @MAGRPTY@(0)="1^OK"
+16 QUIT
HSUM(MAGRPTY,MAGGZ) ;RPC Call to Get Health Summary for Patient
+1 ; MAGGZ -> DFN ^ HS Type (IEN)
+2 ;
+3 NEW Y,X,GMTSTYP,GMTSTITL
+4 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTCPR"
+5 IF '$TEST
SET X="ERRA^MAGGTCPR"
SET @^%ZOSF("TRAP")
+6 SET MAGRPTY=$NAME(^TMP($JOB,"WSDAT"))
+7 KILL @MAGRPTY
+8 SET @MAGRPTY@(0)="0^Health Summary Report NOT successful"
+9 SET IOP="IMAGING WORKSTATION"
SET %ZIS=0
DO ^%ZIS
if POP
QUIT
+10 SET GMTSTYP=$PIECE(MAGGZ,U,2)
SET DFN=$PIECE(MAGGZ,U)
+11 SET GMTSTITL=$$GET1^DIQ(142,GMTSTYP,".02","I")
+12 USE IO
+13 DO SELTYP1^GMTS
DO EN^GMTS1
+14 ; MOD GEK 5\13\96
DO END^GMTS
KILL GMTSEG,GMTSEGI,GMTSEGC
+15 if IO'=IO(0)
DO ^%ZISC
+16 SET @MAGRPTY@(0)="1^OK"
+17 QUIT
HSLIST(MAGRY,ZY) ;RPC Call To do a lookup using LIST^DIC to return
+1 ; the List of Health Summary Types for a user to select from.
+2 ; MAGRY is the Array to return.
+3 ; ZY is NOT USED
+4 ; Kernel uses Y, we have to New it because calls to DIC etc
+5 ; also use it and change it, and kill it.
+6 NEW Y,XI,Z,FI,MAGIEN,INFO
+7 NEW FILE,IENS,FLDS,FLAGS,VAL,NUM,FROM,PART,INDEX,SCR,IDENT,TROOT
+8 SET (FILE,IENS,FLDS,FLAGS,VAL,NUM,FROM,PART,INDEX,SCR,IDENT,TROOT)=""
+9 ;
+10 ; Format
+11 ;LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,
+12 ; [.]FROM,[.]PART,INDEX,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
+13 ;
+14 ; is this necessary ?
KILL ^TMP("DILIST",$JOB)
+15 ; This is.
KILL ^TMP("DIERR",$JOB)
+16 SET FILE=142
SET NUM=9000
SET FROM=""
SET PART=""
SET FLDS="@;.01"
SET INDEX="B"
+17 DO LIST^DIC(FILE,IENS,FLDS,FLAGS,NUM,FROM,PART,INDEX,SCR,IDENT,TROOT)
+18 ;
+19 IF '$DATA(^TMP("DILIST",$JOB,2))
Begin DoDot:1
+20 SET MAGRY(XI)="0^NO Health Summary Types Found in VistA"
End DoDot:1
QUIT
+21 SET INFO=^TMP("DILIST",$JOB,0)
+22 SET XI=""
FOR
SET XI=$ORDER(^TMP("DILIST",$JOB,2,XI))
if XI=""
QUIT
SET MAGIEN=^(XI)
Begin DoDot:1
+23 SET Z=".01"
SET X=^TMP("DILIST",$JOB,"ID",XI,Z)
+24 FOR
SET Z=$ORDER(^TMP("DILIST",$JOB,"ID",XI,Z))
if Z=""
QUIT
SET X=X_" "_^(Z)
+25 SET MAGRY(XI)=X_"^"_MAGIEN
End DoDot:1
+26 ;
+27 SET MAGRY(0)=$PIECE(INFO,"^")_U_"Found "_$PIECE(INFO,"^")_" entr"_$SELECT((+INFO=1):"y",1:"ies")
+28 IF $PIECE(INFO,"^",3)>0
SET MAGRY(0)=MAGRY(0)_" there are more"
+29 QUIT
DISSUM(MAGRPTY,DFN) ; Discharge summary
+1 SET MAGRPTY=$NAME(^TMP($JOB,"WSDAT"))
+2 SET @MAGRPTY@(0)="0^NOT YET IMPLEMENTED"
+3 QUIT
ERRA SET @MAGRPTY@(0)="0^"_$$EC^%ZOSV
+1 DO @^%ZOSF("ERRTN")
+2 QUIT
