| [613] | 1 | VAQPSE01 ;ALB/JRP,JFP - EXPORTED PDX ROUTINE;9-FEB-94
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
|
|---|
| 3 | GMTSPDX ; SLC/JER,SBW - PDX Health Summary Driver ;12/29/93 16:41
|
|---|
| 4 | ;;2.5;Health Summary;**8**;Dec 16, 1992
|
|---|
| 5 | GET(TRAN,DFN,SEGPTR,ROOT,GMTSLCNT,GMTSDLM,GMTSNDM) ; Get HS for PDX
|
|---|
| 6 | ; Data retrieved from HS is return in ROOT parmeter reference passing.
|
|---|
| 7 | ; Function returns 2 piece variable delimited with "^".
|
|---|
| 8 | ; Piece 1 = tot line cnt of data extract to ROOT.
|
|---|
| 9 | ; Piece 2 = contains entry line cnt (GMTSLCNT) + Piece 1
|
|---|
| 10 | ; Note: Currently Data begins with GMTSLCNT + 1 and
|
|---|
| 11 | ; Piece 2 is last node # of ROOT
|
|---|
| 12 | ; : If TRAN is passed
|
|---|
| 13 | ; The patient pointer of the transaction will be used
|
|---|
| 14 | ; Encryption will be based on the transaction
|
|---|
| 15 | ; If DFN is passed
|
|---|
| 16 | ; Encryption will be based on the site parameter
|
|---|
| 17 | ; : Pointer to transaction takes precedence over DFN ... if
|
|---|
| 18 | ; TRAN>0 the DFN will be based on the transaction
|
|---|
| 19 | ;
|
|---|
| 20 | ;DETERMINE TRUE DFN
|
|---|
| 21 | S TRAN=+$G(TRAN)
|
|---|
| 22 | S DFN=+$G(DFN)
|
|---|
| 23 | Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
|
|---|
| 24 | I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
|
|---|
| 25 | I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
|
|---|
| 26 | Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
|
|---|
| 27 | ;
|
|---|
| 28 | ; Scope FM local variables that don't get cleaned up by %ZIS
|
|---|
| 29 | ; SPOOLER call
|
|---|
| 30 | N C,D0,DA,DI,DIE,DIC,DQ,DR,GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM
|
|---|
| 31 | N GMTSDUZ,GMTSLO,GMTSLPG,GMTSPNM,GMTSRB,GMTSSN,GMTSSPL,GMTSWARD,GMTSY
|
|---|
| 32 | N SEX,SPLDOC,VADM,VAERR,VAIN,X,Y,ZISIOST
|
|---|
| 33 | N %,%X,%XX,%Y,%YY,%Z4,%ZDA,%ZS,%ZY,POP
|
|---|
| 34 | S GMTSDUZ=$G(DUZ),GMTSSPL=$P($G(^GMT(142.99,1,0)),U,4),DUZ=.5
|
|---|
| 35 | I GMTSSPL']"" S GMTSY="-1^No Spool Device allocated" G GETX
|
|---|
| 36 | ;CONVERT SEGPTR TO ENTRY IN HEALTH SUMMARY COMPONENT FILE
|
|---|
| 37 | S X=+$P($G(^VAT(394.71,SEGPTR,0)),"^",4)
|
|---|
| 38 | I ('X) S GMTSY="-1^Unable to convert PDX data segment to Health Summary component" G GETX
|
|---|
| 39 | S SEGPTR=X
|
|---|
| 40 | ;DETERMINE IF COMPONENT HAS BEEN DISABLED
|
|---|
| 41 | S X=$G(^GMT(142.1,SEGPTR,0))
|
|---|
| 42 | I (($P(X,"^",6)="T")!($P(X,"^",6)="P")) D G GETX
|
|---|
| 43 | .;DISABLED
|
|---|
| 44 | .S GMTSY=$P(X,"^",8)
|
|---|
| 45 | .I (GMTSY'="") S GMTSY="-1^"_GMTSY Q
|
|---|
| 46 | .S GMTSY="-1^Component has been disabled "
|
|---|
| 47 | .S GMTSY=GMTSY_$S($P(X,"^",6)="T":"(temporary)",1:"(permanent)")
|
|---|
| 48 | ;OPEN SPOOL DEVICE
|
|---|
| 49 | S IOP=GMTSSPL_";HSPDX"_DFN D ^%ZIS
|
|---|
| 50 | I POP S GMTSY="-1^Spool open failed" G GETX
|
|---|
| 51 | D ONECOMP(DFN,SEGPTR,$G(GMTSDLM),$G(GMTSNDM)) ; Write component
|
|---|
| 52 | S SPLDOC=$G(IO("SPOOL")) D ^%ZISC
|
|---|
| 53 | I +SPLDOC D
|
|---|
| 54 | . N SPLSTAT,SPLPTR,GMTSDOC
|
|---|
| 55 | . ; Wait until spool document is "ready" (ONLY CHECK EVERY 5 SECONDS)
|
|---|
| 56 | . F S SPLSTAT=$P($G(^XMB(3.51,SPLDOC,0)),U,3) Q:SPLSTAT="r" H 5
|
|---|
| 57 | . S GMTSDOC=$G(^XMB(3.51,SPLDOC,0)),SPLPTR=$P(GMTSDOC,U,10)
|
|---|
| 58 | . I '+SPLPTR!('+$P(GMTSDOC,U,9)) S GMTSY="-1^No data available" Q
|
|---|
| 59 | . S GMTSY=$$XFER(SPLPTR,ROOT,GMTSDOC,+$G(GMTSLCNT))
|
|---|
| 60 | . D DSDOC^ZISPL(SPLPTR),DSD^ZISPL(SPLDOC)
|
|---|
| 61 | .;CHECK TO SEE IF ENCRYPTION IS ON
|
|---|
| 62 | .S:(TRAN) X=$$TRANENC^VAQUTL3(TRAN,0)
|
|---|
| 63 | .S:('TRAN) X=$$NCRYPTON^VAQUTL2(0)
|
|---|
| 64 | .S:(X) X=$$ENCDSP^VAQHSH(TRAN,ROOT,X,(GMTSLCNT+1),+GMTSY)
|
|---|
| 65 | E S GMTSY="-1^Spool document not created"
|
|---|
| 66 | GETX S DUZ=+$G(GMTSDUZ)
|
|---|
| 67 | Q $G(GMTSY)
|
|---|
| 68 | ONECOMP(DFN,SEGPTR,GMTSDLM,GMTSNDM) ; Print a single HS component to IO
|
|---|
| 69 | N GMTSEG,GMTSEGI,GMTSEGC,GMTSTITL
|
|---|
| 70 | S GMTSTITL="PDX TRANSMISSION"
|
|---|
| 71 | S GMTSEG(1)=1_U_SEGPTR_U_$G(GMTSNDM)_U_$G(GMTSDLM)
|
|---|
| 72 | S (GMTSEGI(SEGPTR),GMTSEGC)=1
|
|---|
| 73 | D EN^GMTS1
|
|---|
| 74 | Q
|
|---|
| 75 | XFER(SPLDAT,ROOT,GMTSDOC,GMTSLCNT) ; Transfer text from SPOOL DOC to ROOT
|
|---|
| 76 | N GMTSI,GMTSL,GMTSREC,GMTSPRT,GMTSX S (GMTSI,GMTSL)=0,GMTSPRT=1
|
|---|
| 77 | F S GMTSI=$O(^XMBS(3.519,SPLDAT,2,GMTSI)) Q:+GMTSI'>0 D Q:$E(GMTSREC,1,7)="*** END"
|
|---|
| 78 | . S GMTSREC=$G(^XMBS(3.519,SPLDAT,2,GMTSI,0))
|
|---|
| 79 | . ;Don't transfer data until a line with 3 hyphens or ** DECEASED **
|
|---|
| 80 | . ;is found nor after "*** END" is found
|
|---|
| 81 | . I (GMTSL=0&($E(GMTSREC,1,3)="---")!(GMTSREC["** DECEASED **"))!((GMTSL>0)&($E(GMTSREC,1,7)'="*** END")) D
|
|---|
| 82 | . . I GMTSREC["|TOP|" S GMTSPRT=0
|
|---|
| 83 | . . S:GMTSPRT GMTSL=GMTSL+1,GMTSLCNT=GMTSLCNT+1,@ROOT@("DISPLAY",GMTSLCNT,0)=GMTSREC
|
|---|
| 84 | . . I GMTSREC["(continued)" S GMTSPRT=1
|
|---|
| 85 | I +GMTSL,$P(GMTSDOC,U,11) D ;incomplete report indicator
|
|---|
| 86 | . S GMTSL=GMTSL+1,@ROOT@("DISPLAY",GMTSL,0)="*** Data is incomplete ***"
|
|---|
| 87 | I '+GMTSL S GMTSL="-1^Text transfer from Spool Document failed"
|
|---|
| 88 | Q $G(GMTSL)_U_$G(GMTSLCNT)
|
|---|
