source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPSE01.m@ 1096

Last change on this file since 1096 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1VAQPSE01 ;ALB/JRP,JFP - EXPORTED PDX ROUTINE;9-FEB-94
2 ;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
3GMTSPDX ; SLC/JER,SBW - PDX Health Summary Driver ;12/29/93 16:41
4 ;;2.5;Health Summary;**8**;Dec 16, 1992
5GET(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"
66GETX S DUZ=+$G(GMTSDUZ)
67 Q $G(GMTSY)
68ONECOMP(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
75XFER(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)
Note: See TracBrowser for help on using the repository browser.