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

PSJPADIU.m

Go to the documentation of this file.
  1. PSJPADIU ;BP/VGH-INPATIENT PADE INVENTORY FILE UTILITIES ;3/20/18 8:35 AM
  1. ;;5.0;INPATIENT MEDICATIONS ;**356**;16 DEC 97;Build 7
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. FILDEV(PADATA,ERRMSG) ; File PADE DEVICE to PADE INVENTORY file
  1. N FDA,PSJPSYS,PSJSCR,PSJSCR
  1. I '($G(PADATA(2))]"") S ERRMSG="MISSING PADE DEVICE" Q 0
  1. I $G(PSJPSYS),$G(^PS(58.601,+PSJPSYS,0))]"" S PADATA("SYS IEN")=PSJPSYS
  1. S PSJPSYS=PADATA("SYS IEN"),PSJSCR="I $S('$G(PSJPSYS):1,1:PSJPSYS=$P(^(0),U,2))"
  1. I ($G(PADATA(1))=""&$G(PSJPSYS)) S PADATA(1)=$P(^PS(58.601,PSJPSYS,0),"^")
  1. K ERR S PADATA("DEVICE IEN")=$$FIND1^DIC(58.63,,"X",PADATA(2),,PSJSCR,"ERR") K DIERR ;*356- remove M (multiple index lookup)
  1. I '$G(PADATA("DEVICE IEN")) D
  1. .N FDA S FDA(58.63,"?+1,",.01)=PADATA(2)
  1. .S FDA(58.63,"?+1,",1)=PADATA(1)
  1. .S FDA(58.63,"?+1,",12)=$$UPPER^PSJPDRUT(PADATA(2))
  1. .K ERR,DIERR D UPDATE^DIE("E","FDA","","ERR") K DIERR ;*356
  1. .K ERR,DIERR S PADATA("DEVICE IEN")=$$FIND1^DIC(58.63,,"X",PADATA(2),,PSJSCR,"ERR") K DIERR ;*356- remove M (multiple index lookup)
  1. I $G(PADATA("DEVICE IEN")) D
  1. .N FDA S FDA(58.6011,"?+1,"_PADATA("SYS IEN")_",",.01)=PADATA(2) K ERR D UPDATE^DIE("E","FDA","","ERR") K DIERR ;*356
  1. .K ERR,DIERR S PADATA("DEVICE IEN")=$$FIND1^DIC(58.6011,","_PADATA("SYS IEN")_",","BX",PADATA(2),,,"ERR") K DIERR ;*356- replaced M (multiple index lookup) with B
  1. I '$G(PADATA("DEVICE IEN")) S ERRMSG="Unable to file PADE Device "_PADATA(2) Q 0
  1. Q 1