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

VAQLED07.m

Go to the documentation of this file. 
  1. VAQLED07 ;ALB/JFP,JRP - DISPLAY MINIMAL DATA/ADD NEW PATIENT ;01MAR93 [ 12/04/96  9:23 AM ]
  1.  ;;1.5;PATIENT DATA EXCHANGE;**13,22,23,43**;NOV 17, 1993
  1. EP ; -- Main entry point for the list processor
  1.  ;    Note: sets flag 'VAQADFL' if required elements are blank
  1.  ;
  1.  K ^TMP("VAQD1",$J),^TMP("VAQDIS",$J)
  1.  S (VAQADFL,VALMCNT)=0
  1.  ;
  1. EXTR ; -- Extract PDX minimal data
  1.  S DFN=DFNTR
  1.  S ROOT="^TMP(""VAQDIS"",$J)"
  1.  S SEGPTR=$O(^VAT(394.71,"C","PDX*MIN",""))
  1.  S VAQIGNC=1 ; -- turns of encryption
  1.  S X=$$SEGEXT^VAQUPD1(DFN,SEGPTR,ROOT)
  1.  I +X=-1 W !,"Extract not successful...Error: "_$P(X,U,2) D PAUSE^VALM1 QUIT
  1.  ; -- extraction sucessful,check for missing data
  1.  D CHKNULL
  1.  I VAQADFL=1 D  Q
  1.  .S VAQST="** Unable to load patient...required elements missing"
  1.  .D EN^VALM("VAQ DIS MIN NUPD") ; -- Protocol = VAQ DIS1 (MENU)
  1.  S VAQST="** <AP> attempt to add new patient or <RETURN> to exit"
  1.  D EN^VALM("VAQ DIS MIN UPD") ; -- protocol = VAQ PDX7 (MENU)
  1.  QUIT
  1.  ;
  1. INIT ; -- Builds array of minimal data for the patient entered (DFN)
  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 S MSG="Display load not successful...Error: "_$P(X,U,2) D ERRMSG QUIT
  1.  S VALMCNT=+X-1
  1.  D DISMSG
  1.  K VALMBCK
  1.  QUIT
  1.  ;
  1. HD ; -- Make header line for list processor
  1.  D HD1^VAQEXT02 QUIT
  1.  ;
  1. ADD ; -- Adds new patient to local data base
  1.  D CLEAR^VALM1
  1.  W !,"Please wait while information on ",$G(^TMP("VAQDIS",$J,"VALUE",2,.01,0))," is added",!
  1.  I $G(^TMP("VAQDIS",$J,"VALUE",2,.09,0))'["P",$O(^DPT("SSN",$G(^TMP("VAQDIS",$J,"VALUE",2,.09,0)),"")) D  Q
  1.  . W !!,$C(7),"** Patient not added, SSN in use by existing patient"
  1.  . W !
  1.  . D TRANEX
  1.  S DIC="^DPT("
  1.  S DIC(0)="EL"
  1.  S DLAYGO=2
  1.  S X=$G(^TMP("VAQDIS",$J,"VALUE",2,.01,0))
  1.  S DIC("DR")=".03///"_$G(^TMP("VAQDIS",$J,"VALUE",2,.03,0))
  1.  F I=.09,391,1901 S DIC("DR")=DIC("DR")_";"_I_"///"_$G(^TMP("VAQDIS",$J,"VALUE",2,I,0))
  1.  K DD,D0 D FILE^DICN K DIC,DLAYGO
  1.  I $P(Y,U,3)'=1 W !!,$C(7),"** Patient not added",! D TRANEX QUIT
  1.  ;
  1.  ; -- Update workload file (new patient)
  1.  D WORKLD
  1.  ; -- Add rest of information for stub"
  1.  S VAQSTUB=+Y
  1.  S LOCKFLE=$G(^DIC(2,0,"GL"))
  1.  L +(@(LOCKFLE_VAQSTUB_")")):60
  1.  I ('$T) W !,"Could not edit entry...record locked" K LOCKFLE QUIT
  1.  F FLD=.02,.05,.08,.301,.302,.361,.323,.111,.112,.113,.114,.115,.1112,.117 D LOAD
  1.  ; -- load temporary address information, if active
  1.  D TMPADDR QUIT
  1.  L -(@(LOCKFLE_VAQSTUB_")")) K LOCKFLE
  1.  W !,"** PDX minimal information on ",$G(^TMP("VAQDIS",$J,"VALUE",2,.01,0))," has been added"
  1.  D TRANEX
  1.  D EP^VAQLED02
  1.  K VALMBCK
  1.  QUIT
  1.  ;
  1. LOAD ; -- Loads fields to patient file
  1.  S DIE=2,(DA,DFNPT)=VAQSTUB
  1.  S DR=FLD_"///^S X=$G(^TMP(""VAQDIS"",$J,""VALUE"",2,FLD,0))"
  1.  D ^DIE K DIE,DA,DR
  1.  I ($D(Y)#2) W ?10,"- ",$P(^DD(2,FLD,0),U,1),?40," could not be added",!
  1.  QUIT
  1.  ;
  1. TMPADDR ; -- Checks to see if temporary address dates are active and flag set
  1.  ; -- active flag
  1.  I $G(^TMP("VAQDIS",$J,"VALUE",2,.12105,0))="Y" QUIT  ;strt dte 
  1.  I $G(^TMP("VAQDIS",$J,"VALUE",2,.1217,0))'<DT QUIT  ;strt dte
  1.  I $G(^TMP("VAQDIS",$J,"VALUE",2,.1218,0))'>DT QUIT  ;end dte
  1.  ; -- Load temporary address fields
  1.  F FLD=.12105,.1211,.12111,.12112,.1212,.1213,.1214,.1215,.12112,.1217,.1218,.1219 D LOAD
  1.  QUIT
  1.  ;
  1. ERRMSG ; -- Displays error message
  1.  S X=$$SETSTR^VALM1(" ","",1,79) D TMP
  1.  S X=$$SETSTR^VALM1(MSG,"",1,80) D TMP
  1.  S VALMBCK="Q"
  1.  QUIT
  1.  ;
  1. DISMSG ; -- Display status message
  1.  S X=$$SETSTR^VALM1(VAQST,"",1,79) D TMP
  1.  K VAQLN,VAQST
  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. CHKNULL ; -- Sets missing data flag if it finds a required field null
  1.  ; Added quit condition.  NOIS ISD-0495-40199
  1.  S FLD=""
  1.  F FLD=.01,.02,.03,.05,.08,.09,.111,.114,.115,.1112,.117,.323,.361,391,1901 Q:(VAQADFL=1)  D
  1.  .S VAQDATA=$G(^TMP("VAQDIS",$J,"VALUE",2,FLD,0))
  1.  .S:VAQDATA="" VAQADFL=1
  1.  I VAQADFL=0 D
  1.  .S:($G(^TMP("VAQDIS",$J,"VALUE",2,.302,0))=""&($G(^TMP("VAQDIS",$J,"VALUE",2,.301,0))'="NO")) VAQADFL=0
  1.  K FLD,VAQDATA
  1.  QUIT
  1.  ;
  1. TRANEX ; -- Transaction exit
  1.  D PAUSE^VALM1
  1.  S VALMBCK="Q"
  1.  QUIT
  1.  ;
  1. WORKLD ; -- Updates work load file
  1.  S X=$$WORKDONE^VAQADS01("NEW",DFNTR,$G(DUZ))
  1.  I +X<0  W !,"Error updating work loadfile (NEW)... "_$P(X,U,2)
  1.  I $P($G(^VAT(394.61,DFNTR,0)),U,4)=0 QUIT
  1.  S X=$$WORKDONE^VAQADS01("SNSTVE",DFNTR,$G(DUZ))
  1.  I X<0 W !,"Error updating workload file (SNSTVE)... "_$P(X,U,2)
  1.  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 VAQADFL,VAQSTUB,VAQIGNC
  1.  K VALMCNT,ROOT,SEGPTR,X,MSG,XTRCT,OFFSET,DSP
  1.  Q
  1.  ;
  1. END ; -- End of code
  1.  QUIT