| [613] | 1 | VAQREQ02 ;ALB/JFP - PDX, REQUEST PATIENT DATA, REQUEST SCREEN;01MAR93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | EP ; -- Main entry point for the list processor (called from protocol
|
|---|
| 4 | ; vaq create request)
|
|---|
| 5 | ; -- K XQORS,VALMEVL (only kill on the first screen in)
|
|---|
| 6 | K ^TMP("VAQSEG",$J),^TMP("VAQNOTI",$J),^TMP("VAQCOPY",$J)
|
|---|
| 7 | EP1 N X,K,DOM,SEG,SEGMENT,SP50,DISX
|
|---|
| 8 | D EN^VALM("VAQ REQUEST PDX2")
|
|---|
| 9 | K VALMBCK
|
|---|
| 10 | QUIT
|
|---|
| 11 | ;
|
|---|
| 12 | INIT ; -- Initializes variables and defines screen
|
|---|
| 13 | K ^TMP("VAQR2",$J)
|
|---|
| 14 | S (VAQECNT,VALMCNT)=0,(DOM,SEG)=""
|
|---|
| 15 | ;
|
|---|
| 16 | S:VAQOPT="UNS" VALM("TITLE")="PDX V1.5 - UNSOLICITED"
|
|---|
| 17 | I '$D(^TMP("VAQSEG",$J)) D
|
|---|
| 18 | .S DISX=$$SETSTR^VALM1(" ","",1,79) D TMP
|
|---|
| 19 | .S DISX=$$SETSTR^VALM1("** Select an option or <Return> to exit ","",1,79) D TMP
|
|---|
| 20 | F S DOM=$O(^TMP("VAQSEG",$J,DOM)) Q:DOM="" D SETD
|
|---|
| 21 | QUIT
|
|---|
| 22 | ;
|
|---|
| 23 | SETD ;
|
|---|
| 24 | S VAQECNT=VAQECNT+1,K=0
|
|---|
| 25 | S DISX=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
|
|---|
| 26 | S DISX=$$SETFLD^VALM1(DOM,DISX,"DOMAIN")
|
|---|
| 27 | S (SEGMENT,SEG)=""
|
|---|
| 28 | F S SEG=$O(^TMP("VAQSEG",$J,DOM,SEG)) Q:SEG="" D WSEG
|
|---|
| 29 | I K<3 D
|
|---|
| 30 | .S DISX=$$SETFLD^VALM1(SEGMENT,DISX,"SEGMENTS")
|
|---|
| 31 | .D TMP
|
|---|
| 32 | S DISX=$$SETSTR^VALM1(" ","",1,79) D TMP
|
|---|
| 33 | QUIT
|
|---|
| 34 | ;
|
|---|
| 35 | WSEG ;
|
|---|
| 36 | S K=K+1
|
|---|
| 37 | S P1=K*14,POS=P1-14+K ; -- 3 segments across
|
|---|
| 38 | S HSCOMPND=$$HLTHSEG^VAQDBIH1(SEG,0)
|
|---|
| 39 | I $P(HSCOMPND,U,1)'=0 D SEGDIS^VAQEXT06
|
|---|
| 40 | S SEGMENT=$$SETSTR^VALM1(SEG,SEGMENT,POS,14)
|
|---|
| 41 | I K=3 D
|
|---|
| 42 | .S DISX=$$SETFLD^VALM1(SEGMENT,DISX,"SEGMENTS")
|
|---|
| 43 | .D TMP
|
|---|
| 44 | .S SEGMENT="",DISX="",K=0
|
|---|
| 45 | QUIT
|
|---|
| 46 | ;
|
|---|
| 47 | TMP ; -- Set the array used by list processor
|
|---|
| 48 | S VALMCNT=VALMCNT+1
|
|---|
| 49 | S ^TMP("VAQR2",$J,VALMCNT,0)=$E(DISX,1,79)
|
|---|
| 50 | S ^TMP("VAQR2",$J,"IDX",VALMCNT,VAQECNT)=""
|
|---|
| 51 | S ^TMP("VAQIDX",$J,VAQECNT)=DOM
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | HD ; -- Make header line for list processor
|
|---|
| 55 | S SP50=$J("",50)
|
|---|
| 56 | S VALMHDR(1)="Patient : "_$E(VAQNM_SP50,1,38)_"Type: "_VAQEELG
|
|---|
| 57 | S VALMHDR(2)="Patient SSN: "_$E(VAQESSN_SP50,1,39)_"DOB: "_VAQEDOB
|
|---|
| 58 | QUIT
|
|---|
| 59 | ;
|
|---|
| 60 | ; ------------------------ PROTOCOLS -------------------------------
|
|---|
| 61 | REQ ; -- Request Domain and Segment
|
|---|
| 62 | D CLEAR^VALM1
|
|---|
| 63 | D EP^VAQREQ03
|
|---|
| 64 | D INIT
|
|---|
| 65 | S VALMBCK="R"
|
|---|
| 66 | QUIT
|
|---|
| 67 | ;
|
|---|
| 68 | COPY ; -- Copies segments selected from one domain to main domains
|
|---|
| 69 | D SEL^VALM2
|
|---|
| 70 | Q:'$D(VALMY)
|
|---|
| 71 | D CLEAR^VALM1
|
|---|
| 72 | D EP^VAQREQ05
|
|---|
| 73 | D INIT
|
|---|
| 74 | S VALMBCK="R"
|
|---|
| 75 | QUIT
|
|---|
| 76 | ;
|
|---|
| 77 | TRAN ; -- Transmits, Signature, Notify list)
|
|---|
| 78 | S VAQFLAG=0,VAQCMNT="Unsolicited Request "
|
|---|
| 79 | D CLEAR^VALM1
|
|---|
| 80 | I '$D(^TMP("VAQSEG",$J)) W !," ** No request to transmit on file" D TRANEX QUIT
|
|---|
| 81 | S X=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature
|
|---|
| 82 | I X<0 K X D TRANEX QUIT
|
|---|
| 83 | D:VAQOPT="REQ" EP^VAQREQ07 ; -- Notify code
|
|---|
| 84 | D:VAQOPT="UNS" EP^VAQREQ08 ; -- Comment for unsolicited
|
|---|
| 85 | D EP^VAQREQ06 ; -- Transmit
|
|---|
| 86 | K ^TMP("VAQSEG",$J)
|
|---|
| 87 | ;
|
|---|
| 88 | TRANEX D PAUSE^VAQUTL95
|
|---|
| 89 | S VALMBCK=$S(VAQFLAG=0:"R",1:"Q")
|
|---|
| 90 | QUIT
|
|---|
| 91 | ;
|
|---|
| 92 | ;
|
|---|
| 93 | PAT ; -- Change patient by exiting back to patient prompt
|
|---|
| 94 | EXIT ; -- Note: The list processor cleans up its own variables.
|
|---|
| 95 | ; All other variables cleaned up here.
|
|---|
| 96 | ;
|
|---|
| 97 | G:'$D(^TMP("VAQSEG",$J)) EXIT1
|
|---|
| 98 | I $D(^TMP("VAQSEG",$J)) W !!,"WARNING...Exiting this option will delete untransmitted request for this patient" R !,"Exit request? N// ",X:DTIME
|
|---|
| 99 | I ($E(X,1,1)="Y")!($E(X,1,1)="y") G EXIT1
|
|---|
| 100 | I ($E(X,1,1))="^" G EXIT1
|
|---|
| 101 | D EP1
|
|---|
| 102 | ;
|
|---|
| 103 | EXIT1 K X,K,DOM,SEG,SEGMENT,SP50,DISX
|
|---|
| 104 | K ^TMP("VAQSEG",$J),^TMP("VAQNOTI",$J),^TMP("VAQR2",$J),^TMP("VAQCOPY",$J)
|
|---|
| 105 | K VAQEELG,VAQEDOB,VAQNM,VAQESSN,VAQECNT,VAQFLAG,VAQCMNT
|
|---|
| 106 | K LPDOM,OLIMIT,TLIMIT,P1,POS,SEGND,SEGNME,SEGNO,HSCOMPND,OLDEF,TLDEF
|
|---|
| 107 | K PARAMND
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | END ; -- End of code
|
|---|
| 111 | QUIT
|
|---|
