MAGGTCPR.m

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 ---MAGGTCPR   3814     printed  Apr 23, 2025@18:17:29                                                                                                                                                                                                    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