| 1 | VAQLED07 ;ALB/JFP,JRP - DISPLAY MINIMAL DATA/ADD NEW PATIENT ;01MAR93 [ 12/04/96 9:23 AM ]
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**13,22,23,43**;NOV 17, 1993
|
---|
| 3 | EP ; -- Main entry point for the list processor
|
---|
| 4 | ; Note: sets flag 'VAQADFL' if required elements are blank
|
---|
| 5 | ;
|
---|
| 6 | K ^TMP("VAQD1",$J),^TMP("VAQDIS",$J)
|
---|
| 7 | S (VAQADFL,VALMCNT)=0
|
---|
| 8 | ;
|
---|
| 9 | EXTR ; -- Extract PDX minimal data
|
---|
| 10 | S DFN=DFNTR
|
---|
| 11 | S ROOT="^TMP(""VAQDIS"",$J)"
|
---|
| 12 | S SEGPTR=$O(^VAT(394.71,"C","PDX*MIN",""))
|
---|
| 13 | S VAQIGNC=1 ; -- turns of encryption
|
---|
| 14 | S X=$$SEGEXT^VAQUPD1(DFN,SEGPTR,ROOT)
|
---|
| 15 | I +X=-1 W !,"Extract not successful...Error: "_$P(X,U,2) D PAUSE^VALM1 QUIT
|
---|
| 16 | ; -- extraction sucessful,check for missing data
|
---|
| 17 | D CHKNULL
|
---|
| 18 | I VAQADFL=1 D Q
|
---|
| 19 | .S VAQST="** Unable to load patient...required elements missing"
|
---|
| 20 | .D EN^VALM("VAQ DIS MIN NUPD") ; -- Protocol = VAQ DIS1 (MENU)
|
---|
| 21 | S VAQST="** <AP> attempt to add new patient or <RETURN> to exit"
|
---|
| 22 | D EN^VALM("VAQ DIS MIN UPD") ; -- protocol = VAQ PDX7 (MENU)
|
---|
| 23 | QUIT
|
---|
| 24 | ;
|
---|
| 25 | INIT ; -- Builds array of minimal data for the patient entered (DFN)
|
---|
| 26 | S XTRCT=ROOT
|
---|
| 27 | S ROOT="^TMP(""VAQD1"",$J)"
|
---|
| 28 | S (OFFSET,DSP)=0
|
---|
| 29 | S X=$$DISPMIN^VAQDIS21(XTRCT,SEGPTR,ROOT,OFFSET,DSP)
|
---|
| 30 | I +X=-1 S MSG="Display load not successful...Error: "_$P(X,U,2) D ERRMSG QUIT
|
---|
| 31 | S VALMCNT=+X-1
|
---|
| 32 | D DISMSG
|
---|
| 33 | K VALMBCK
|
---|
| 34 | QUIT
|
---|
| 35 | ;
|
---|
| 36 | HD ; -- Make header line for list processor
|
---|
| 37 | D HD1^VAQEXT02 QUIT
|
---|
| 38 | ;
|
---|
| 39 | ADD ; -- Adds new patient to local data base
|
---|
| 40 | D CLEAR^VALM1
|
---|
| 41 | W !,"Please wait while information on ",$G(^TMP("VAQDIS",$J,"VALUE",2,.01,0))," is added",!
|
---|
| 42 | I $G(^TMP("VAQDIS",$J,"VALUE",2,.09,0))'["P",$O(^DPT("SSN",$G(^TMP("VAQDIS",$J,"VALUE",2,.09,0)),"")) D Q
|
---|
| 43 | . W !!,$C(7),"** Patient not added, SSN in use by existing patient"
|
---|
| 44 | . W !
|
---|
| 45 | . D TRANEX
|
---|
| 46 | S DIC="^DPT("
|
---|
| 47 | S DIC(0)="EL"
|
---|
| 48 | S DLAYGO=2
|
---|
| 49 | S X=$G(^TMP("VAQDIS",$J,"VALUE",2,.01,0))
|
---|
| 50 | S DIC("DR")=".03///"_$G(^TMP("VAQDIS",$J,"VALUE",2,.03,0))
|
---|
| 51 | F I=.09,391,1901 S DIC("DR")=DIC("DR")_";"_I_"///"_$G(^TMP("VAQDIS",$J,"VALUE",2,I,0))
|
---|
| 52 | K DD,D0 D FILE^DICN K DIC,DLAYGO
|
---|
| 53 | I $P(Y,U,3)'=1 W !!,$C(7),"** Patient not added",! D TRANEX QUIT
|
---|
| 54 | ;
|
---|
| 55 | ; -- Update workload file (new patient)
|
---|
| 56 | D WORKLD
|
---|
| 57 | ; -- Add rest of information for stub"
|
---|
| 58 | S VAQSTUB=+Y
|
---|
| 59 | S LOCKFLE=$G(^DIC(2,0,"GL"))
|
---|
| 60 | L +(@(LOCKFLE_VAQSTUB_")")):60
|
---|
| 61 | I ('$T) W !,"Could not edit entry...record locked" K LOCKFLE QUIT
|
---|
| 62 | F FLD=.02,.05,.08,.301,.302,.361,.323,.111,.112,.113,.114,.115,.1112,.117 D LOAD
|
---|
| 63 | ; -- load temporary address information, if active
|
---|
| 64 | D TMPADDR QUIT
|
---|
| 65 | L -(@(LOCKFLE_VAQSTUB_")")) K LOCKFLE
|
---|
| 66 | W !,"** PDX minimal information on ",$G(^TMP("VAQDIS",$J,"VALUE",2,.01,0))," has been added"
|
---|
| 67 | D TRANEX
|
---|
| 68 | D EP^VAQLED02
|
---|
| 69 | K VALMBCK
|
---|
| 70 | QUIT
|
---|
| 71 | ;
|
---|
| 72 | LOAD ; -- Loads fields to patient file
|
---|
| 73 | S DIE=2,(DA,DFNPT)=VAQSTUB
|
---|
| 74 | S DR=FLD_"///^S X=$G(^TMP(""VAQDIS"",$J,""VALUE"",2,FLD,0))"
|
---|
| 75 | D ^DIE K DIE,DA,DR
|
---|
| 76 | I ($D(Y)#2) W ?10,"- ",$P(^DD(2,FLD,0),U,1),?40," could not be added",!
|
---|
| 77 | QUIT
|
---|
| 78 | ;
|
---|
| 79 | TMPADDR ; -- Checks to see if temporary address dates are active and flag set
|
---|
| 80 | ; -- active flag
|
---|
| 81 | I $G(^TMP("VAQDIS",$J,"VALUE",2,.12105,0))="Y" QUIT ;strt dte
|
---|
| 82 | I $G(^TMP("VAQDIS",$J,"VALUE",2,.1217,0))'<DT QUIT ;strt dte
|
---|
| 83 | I $G(^TMP("VAQDIS",$J,"VALUE",2,.1218,0))'>DT QUIT ;end dte
|
---|
| 84 | ; -- Load temporary address fields
|
---|
| 85 | F FLD=.12105,.1211,.12111,.12112,.1212,.1213,.1214,.1215,.12112,.1217,.1218,.1219 D LOAD
|
---|
| 86 | QUIT
|
---|
| 87 | ;
|
---|
| 88 | ERRMSG ; -- Displays error message
|
---|
| 89 | S X=$$SETSTR^VALM1(" ","",1,79) D TMP
|
---|
| 90 | S X=$$SETSTR^VALM1(MSG,"",1,80) D TMP
|
---|
| 91 | S VALMBCK="Q"
|
---|
| 92 | QUIT
|
---|
| 93 | ;
|
---|
| 94 | DISMSG ; -- Display status message
|
---|
| 95 | S X=$$SETSTR^VALM1(VAQST,"",1,79) D TMP
|
---|
| 96 | K VAQLN,VAQST
|
---|
| 97 | QUIT
|
---|
| 98 | ;
|
---|
| 99 | TMP ; -- Set the array used by list processor
|
---|
| 100 | S VALMCNT=VALMCNT+1
|
---|
| 101 | S ^TMP("VAQD1",$J,VALMCNT,0)=$E(X,1,79)
|
---|
| 102 | QUIT
|
---|
| 103 | ;
|
---|
| 104 | CHKNULL ; -- Sets missing data flag if it finds a required field null
|
---|
| 105 | ; Added quit condition. NOIS ISD-0495-40199
|
---|
| 106 | S FLD=""
|
---|
| 107 | F FLD=.01,.02,.03,.05,.08,.09,.111,.114,.115,.1112,.117,.323,.361,391,1901 Q:(VAQADFL=1) D
|
---|
| 108 | .S VAQDATA=$G(^TMP("VAQDIS",$J,"VALUE",2,FLD,0))
|
---|
| 109 | .S:VAQDATA="" VAQADFL=1
|
---|
| 110 | I VAQADFL=0 D
|
---|
| 111 | .S:($G(^TMP("VAQDIS",$J,"VALUE",2,.302,0))=""&($G(^TMP("VAQDIS",$J,"VALUE",2,.301,0))'="NO")) VAQADFL=0
|
---|
| 112 | K FLD,VAQDATA
|
---|
| 113 | QUIT
|
---|
| 114 | ;
|
---|
| 115 | TRANEX ; -- Transaction exit
|
---|
| 116 | D PAUSE^VALM1
|
---|
| 117 | S VALMBCK="Q"
|
---|
| 118 | QUIT
|
---|
| 119 | ;
|
---|
| 120 | WORKLD ; -- Updates work load file
|
---|
| 121 | S X=$$WORKDONE^VAQADS01("NEW",DFNTR,$G(DUZ))
|
---|
| 122 | I +X<0 W !,"Error updating work loadfile (NEW)... "_$P(X,U,2)
|
---|
| 123 | I $P($G(^VAT(394.61,DFNTR,0)),U,4)=0 QUIT
|
---|
| 124 | S X=$$WORKDONE^VAQADS01("SNSTVE",DFNTR,$G(DUZ))
|
---|
| 125 | I X<0 W !,"Error updating workload file (SNSTVE)... "_$P(X,U,2)
|
---|
| 126 | QUIT
|
---|
| 127 | ;
|
---|
| 128 | EXIT ; -- Note: The list processor cleans up its own variables.
|
---|
| 129 | ; All other variables cleaned up here.
|
---|
| 130 | ;
|
---|
| 131 | K ^TMP("VAQD1",$J),^TMP("VAQDIS",$J)
|
---|
| 132 | K VAQADFL,VAQSTUB,VAQIGNC
|
---|
| 133 | K VALMCNT,ROOT,SEGPTR,X,MSG,XTRCT,OFFSET,DSP
|
---|
| 134 | Q
|
---|
| 135 | ;
|
---|
| 136 | END ; -- End of code
|
---|
| 137 | QUIT
|
---|