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

VAQDIS01.m

Go to the documentation of this file.
  1. VAQDIS01 ;ALB/JFP - DISPLAY MINIMAL DATA, DRIVER ;01MAR93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. EP ; -- Main entry point for the list processor
  1. ;
  1. PT S VAQTYPE="PT" G EP1 ; -- Minimal data extracted from ^DPT(2,
  1. TR S VAQTYPE="TR" G EP1 ; -- Minimal data extracted from ^VAT(394.62,
  1. ;
  1. EP1 D EN^VALM("VAQ DISPLAY MINIMUM") ; -- Protocol = VAQ DIS1 (MENU)
  1. QUIT
  1. ;
  1. INIT ; -- Builds array of minimal data for the patient entered (DFN)
  1. ;W !,"DFN = ",DFN
  1. K ^TMP("VAQD1",$J),^TMP("VAQDIS",$J)
  1. N ROOT,SEGPTR,X,MSG,VAQIGNC,XTRCT,OFFSET
  1. S (VAQADFL,ERRPOP,VALMCNT)=0
  1. ;
  1. S ROOT="^TMP(""VAQDIS"",$J)"
  1. S SEGPTR=$O(^VAT(394.71,"C","PDX*MIN",""))
  1. S VAQIGNC=1 ; -- turns of encryption
  1. I VAQTYPE="PT" D
  1. .D CHGCAP^VALM("LOCAL"," Local Patient Data")
  1. .S X=$$SEGXTRCT^VAQDBI(0,DFN,ROOT,SEGPTR)
  1. I VAQTYPE="TR" D
  1. .D CHGCAP^VALM("LOCAL"," Remote Patient Data")
  1. .S X=$$SEGEXT^VAQUPD1(DFN,SEGPTR,ROOT)
  1. I +X=-1 D QUIT
  1. .S MSG="Extract not successful...Error: "_$P(X,U,2)
  1. .S X=$$SETSTR^VALM1(" ","",1,79) D TMP
  1. .S X=$$SETSTR^VALM1(MSG,"",1,80) D TMP
  1. .S ERRPOP=1
  1. ; -- extraction sucessful, call display load
  1. S XTRCT=ROOT
  1. S ROOT="^TMP(""VAQD1"",$J)"
  1. S (OFFSET,DSP)=0
  1. S X=$$DISPMIN^VAQDIS21(XTRCT,SEGPTR,ROOT,OFFSET,DSP)
  1. I +X=-1 D QUIT
  1. .S MSG="Display load not successful...Error: "_$P(X,U,2)
  1. .S X=$$SETSTR^VALM1(" ","",1,79) D TMP
  1. .S X=$$SETSTR^VALM1(MSG,"",1,80) D TMP
  1. .S ERRPOP=1
  1. S VALMBCK="Q"
  1. QUIT
  1. ;
  1. TMP ; -- Set the array used by list processor
  1. S VALMCNT=VALMCNT+1
  1. S ^TMP("VAQD1",$J,VALMCNT,0)=$E(X,1,79)
  1. QUIT
  1. ;
  1. HD ; -- Make header line for list processor
  1. D HD1^VAQEXT02 QUIT
  1. ;
  1. EXIT ; -- Note: The list processor cleans up its own variables.
  1. ; All other variables cleaned up here.
  1. ;
  1. K ^TMP("VAQD1",$J),^TMP("VAQDIS",$J)
  1. K VAQTYPE,VAQIGNC
  1. K ROOT,SEGPTR,X,MSG,XTRCT,OFFSET,DSP,ERRPOP
  1. Q
  1. ;
  1. END ; -- End of code
  1. QUIT