Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSPDX

GMTSPDX.m

Go to the documentation of this file. 
  1. GMTSPDX ;SLC/JER,SBW - PDX Health Summary Driver ; 08/27/2002
  1.  ;;2.7;Health Summary;56;Oct 20, 1995
  1.  ;
  1.  ; External References
  1.  ;   DBIA   298  ^VAT(394.61
  1.  ;   DBIA   820  ^VAT(394.71
  1.  ;   DBIA   819  $$ENCDSP^VAQHSH
  1.  ;   DBIA   818  $$NCRYPTON^VAQUTL2
  1.  ;   DBIA   817  $$TRANENC^VAQUTL3
  1.  ;   DBIA  3587  ^XMB(3.51
  1.  ;   DBIA  2056  $$GET1^DIQ (file 3.51)
  1.  ;   DBIA  3588  ^XMBS(3.519
  1.  ;   DBIA   999  ^DD(142.99
  1.  ;   DBIA 10035  ^DPT(
  1.  ;   DBIA 10086  ^%ZIS
  1.  ;   DBIA 10089  ^%ZISC
  1.  ;   DBIA 10004  Y^DIQ
  1.  ;   DBIA  1092  DSD^ZISPL
  1.  ;   DBIA  1092  DSDOC^ZISPL
  1.  ;                    
  1. GET(TRAN,DFN,SEGPTR,ROOT,GMTSLCNT,GMTSDLM,GMTSNDM) ; Get HS for PDX
  1.  ;                       
  1.  ; Data retrieved from HS is return in ROOT parameter
  1.  ; reference passing.  Function returns 2 piece 
  1.  ; variable delimited with "^".
  1.  ;                     
  1.  ;   Piece 1 = tot line cnt of data extract to ROOT.
  1.  ;   Piece 2 = contains entry line cnt (GMTSLCNT) + Piece 1
  1.  ;                  
  1.  ; Note: Currently Data begins with GMTSLCNT + 1 and
  1.  ;       Piece 2 is last node # of ROOT
  1.  ;                        
  1.  ;     If TRAN is passed
  1.  ;         The patient pointer of the transaction will be used
  1.  ;         Encryption will be based on the transaction
  1.  ;                        
  1.  ;     If DFN is passed
  1.  ;         Encryption will be based on the site parameter
  1.  ;                        
  1.  ;     Pointer to transaction takes precedence over DFN ... if
  1.  ;         TRAN>0 the DFN will be based on the transaction
  1.  ;                         
  1.  ;   Determin true DFN
  1.  S TRAN=+$G(TRAN),DFN=+$G(DFN)
  1.  Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
  1.  I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
  1.  I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
  1.  Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
  1.  ;   NEW variables not cleaned up by %ZIS SPOOLER call
  1.  N C,D0,DA,DI,DIE,DIC,DQ,DR,GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM
  1.  N GMTSDUZ,GMTSLO,GMTSLPG,GMTSPNM,GMTSRB,GMTSSN,GMTSSPL,GMTSWARD,GMTSY
  1.  N SEX,SPLDOC,VADM,VAERR,VAIN,X,Y,ZISIOST,LINES,INCOMP
  1.  N %,%X,%XX,%Y,%YY,%Z4,%ZDA,%ZS,%ZY,POP,Y,C
  1.  S GMTSDUZ=$G(DUZ),DUZ=.5
  1.  S Y=$P($G(^GMT(142.99,1,0)),U,4),C=$P(^DD(142.99,.04,0),U,2)
  1.  D Y^DIQ
  1.  S GMTSSPL=Y
  1.  I GMTSSPL']"" S GMTSY="-1^No Spool Device allocated" G GETX
  1.  ;   Convert SEGPTR to entry in file 142.1
  1.  S X=+$P($G(^VAT(394.71,SEGPTR,0)),"^",4)
  1.  I ('X) S GMTSY="-1^Unable to convert PDX data segment to Health Summary component" G GETX
  1.  S SEGPTR=X
  1.  ;   Determin if Component has benn disabled
  1.  S X=$G(^GMT(142.1,SEGPTR,0))
  1.  I (($P(X,"^",6)="T")!($P(X,"^",6)="P")) D  G GETX
  1.  .S GMTSY=$P(X,"^",8)
  1.  .I (GMTSY'="") S GMTSY="-1^"_GMTSY Q
  1.  .S GMTSY="-1^Component has been disabled  "
  1.  .S GMTSY=GMTSY_$S($P(X,"^",6)="T":"(temporary)",1:"(permanent)")
  1.  ;   Open SPOOL Device
  1.  S IOP=GMTSSPL_";HSPDX"_DFN D ^%ZIS
  1.  I POP S GMTSY="-1^Spool open failed" G GETX
  1.  ;   Write Component
  1.  D ONECOMP(DFN,SEGPTR,$G(GMTSDLM),$G(GMTSNDM))
  1.  S SPLDOC=$G(IO("SPOOL")) D ^%ZISC
  1.  I +SPLDOC D
  1.  . N SPLSTAT,SPLPTR,LINES,INCOMP
  1.  . ;   Wait until document is "ready" (Check every 5 seconds)
  1.  . F  Q:$$GET1^DIQ(3.51,(+SPLDOC_","),2,"I")="r"  H 5
  1.  . S SPLPTR=$$GET1^DIQ(3.51,(+SPLDOC_","),9,"I")
  1.  . S LINES=$$GET1^DIQ(3.51,(+SPLDOC_","),8,"I")
  1.  . S INCOMP=+($$GET1^DIQ(3.51,(+SPLDOC_","),10,"I"))
  1.  . I '+SPLPTR!('+LINES) S GMTSY="-1^No data available" Q
  1.  . S GMTSY=$$XFER(SPLPTR,ROOT,INCOMP,+$G(GMTSLCNT))
  1.  . D DSDOC^ZISPL(SPLDOC),DSD^ZISPL(SPLPTR)
  1.  . ;   Check to see if Encryption is ON
  1.  . S:(TRAN) X=$$TRANENC^VAQUTL3(TRAN,0)
  1.  . S:('TRAN) X=$$NCRYPTON^VAQUTL2(0)
  1.  . S:(X) X=$$ENCDSP^VAQHSH(TRAN,ROOT,X,(GMTSLCNT+1),+GMTSY)
  1.  E  S GMTSY="-1^Spool document not created"
  1. GETX ;   End Getting HS for PDX
  1.  S DUZ=+$G(GMTSDUZ)
  1.  Q $G(GMTSY)
  1.  ;                  
  1. ONECOMP(DFN,SEGPTR,GMTSDLM,GMTSNDM) ; Print a single HS component to IO
  1.  N GMTSEG,GMTSEGI,GMTSEGC,GMTSTITL
  1.  S GMTSTITL="PDX TRANSMISSION"
  1.  S GMTSEG(1)=1_U_SEGPTR_U_$G(GMTSNDM)_U_$G(GMTSDLM)_U_U_"N"_U_"L"_U_"Y"
  1.  S (GMTSEGI(SEGPTR),GMTSEGC)=1
  1.  D EN^GMTS1
  1.  Q
  1.  ;                  
  1. XFER(SPLDAT,ROOT,INCOMP,GMTSLCNT) ; Transfer text from SPOOL DOC to ROOT
  1.  N GMTSI,GMTSL,GMTSREC,GMTSPRT,GMTSX S (GMTSI,GMTSL)=0,GMTSPRT=1
  1.  F  S GMTSI=$O(^XMBS(3.519,SPLDAT,2,GMTSI)) Q:+GMTSI'>0  D  Q:$E(GMTSREC,1,7)="*** END"
  1.  . S GMTSREC=$G(^XMBS(3.519,SPLDAT,2,GMTSI,0))
  1.  . ;                              
  1.  . ;   Don't transfer data until a line with 3 hyphens or 
  1.  . ;   ** DECEASED ** is found nor after "*** END" is found
  1.  . ;                              
  1.  . I (GMTSL=0&($E(GMTSREC,1,3)="---")!(GMTSREC["** DECEASED **"))!((GMTSL>0)&($E(GMTSREC,1,7)'="*** END")) D
  1.  . . I GMTSREC["|TOP|" S GMTSPRT=0
  1.  . . S:GMTSPRT GMTSL=GMTSL+1,GMTSLCNT=GMTSLCNT+1,@ROOT@("DISPLAY",GMTSLCNT,0)=GMTSREC
  1.  . . I GMTSREC["(continued)" S GMTSPRT=1
  1.  ;   Incomplete Report Indicator
  1.  I +GMTSL,+($G(INCOMP)) D
  1.  . S GMTSL=GMTSL+1,@ROOT@("DISPLAY",GMTSL,0)="*** Data is incomplete ***"
  1.  ;   Transfer Failed
  1.  I '+GMTSL S GMTSL="-1^Text transfer from Spool Document failed"
  1.  Q $G(GMTSL)_U_$G(GMTSLCNT)