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

HMPPTDEM.m

Go to the documentation of this file. 
  1. HMPPTDEM  ;ASMR/EJK,JD - File Patient Demographic Information passed via RPC ; 09/16/2014
  1.  ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Oct 10, 2014;Build 63
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; RPC = HMP WRITEBACK PT DEM
  1.  ;
  1.  ; *** NOTES ***
  1.  ; Return variable must be an ARRAY
  1.  ; A success MUST be sent as a 1
  1.  ; A failure may take any form
  1.  ; *************
  1.  ;
  1.  Q  ;Must come in at a tag.
  1.  ;
  1. FILE(RSP,HMPDEM) ;File Patient Demographic information.
  1.  ;Inbound data layout:
  1.  ; "^" delimited
  1.  ; Piece 1: DFN
  1.  ; Piece 2: Home Phone Number - ^DD(2,.131 - ^DPT(DFN,.13) piece 1
  1.  ; Piece 3: Cell Phone Number - ^DD(2,.134 - ^DPT(DFN,.13) piece 4
  1.  ; Piece 4: Work Phone Number - ^DD(2,.132 - ^DPT(DFN,.13) piece 2
  1.  ; Piece 5: Emergency Phone Number - ^DD(2,.339 - ^DPT(DFN,.33) piece 9
  1.  ; Piece 6: NOK Phone Number - ^DD(2,.219 - ^DPT(DFN,.21) piece 9
  1.  ;
  1.  ; If a piece contains -1, it means DELETE it
  1.  ; If a piece is null, it means LEAVE it ALONE
  1.  ; If a piece is not -1 and not null, it means UPDATE it
  1.  ; 
  1.  ;D BEFORE  ; testing ONLY
  1.  D PROC
  1.  ;D AFTER  ; testing ONLY
  1.  Q
  1.  ;
  1. PROC ;
  1.  N HMPDFN,HMPHPN,HMPCPN,HMPWPN,HMPEPN,HMPNPN,RSPCNT
  1.  N HMPER,HMPX
  1.  K HMPX
  1.  S RSPCNT=0,HMPER=""
  1.  S HMPDFN=$P(HMPDEM,"^",1)
  1.  S HMPHPN=$P(HMPDEM,"^",2)
  1.  S HMPCPN=$P(HMPDEM,"^",3)
  1.  S HMPWPN=$P(HMPDEM,"^",4)
  1.  S HMPEPN=$P(HMPDEM,"^",5)
  1.  S HMPNPN=$P(HMPDEM,"^",6)
  1.  S DA=HMPDFN
  1.  K RSP
  1.  S RSP(0)=1 ;"Writeback was successful"  ; default to good news!
  1.  I HMPDFN']"" S RSP(0)="No DFN" Q
  1.  I '$D(^DPT(HMPDFN)) S RSP(0)="Patient does not exist.  DFN: "_HMPDFN Q  ;ICR 10035 DE2818 ASF 11/12/15
  1.  I $$GET1^DIQ(2,HMPDFN_",",.331)']"",HMPEPN]"" S RSP(0)="Setting EM CO PH w/o EM CO Name" Q
  1.  I $$GET1^DIQ(2,HMPDFN_",",.211)']"",HMPNPN]"" S RSP(0)="Setting NOK PH w/o NOK Name" Q
  1.  S HMPX(2,DA_",",.131)=$S(HMPHPN=-1:"",HMPHPN="":$$GET1^DIQ(2,HMPDFN_",",.131),1:HMPHPN)
  1.  S HMPX(2,DA_",",.132)=$S(HMPWPN=-1:"",HMPWPN="":$$GET1^DIQ(2,HMPDFN_",",.132),1:HMPWPN)
  1.  S HMPX(2,DA_",",.134)=$S(HMPCPN=-1:"",HMPCPN="":$$GET1^DIQ(2,HMPDFN_",",.134),1:HMPCPN)
  1.  S HMPX(2,DA_",",.219)=$S(HMPNPN=-1:"",HMPNPN="":$$GET1^DIQ(2,HMPDFN_",",.219),1:HMPNPN)
  1.  S HMPX(2,DA_",",.339)=$S(HMPEPN=-1:"",HMPEPN="":$$GET1^DIQ(2,HMPDFN_",",.339),1:HMPEPN)
  1.  D UPDATE^DIE(,"HMPX",,"HMPER")
  1.  I HMPER]"" S RSP(0)=HMPER
  1.  Q
  1. BEFORE ;
  1.  S DFN=$P(HMPDEM,"^",1)
  1.  K HPN,CPN,WPN,EPN,NPN,PTNAME
  1.  S (HPN,CPN,WPN,EPN,NPN)=""
  1.  S PTNAME=$$GET1^DIQ(2,DFN_",",.01,"E")
  1.  S HPN=$$GET1^DIQ(2,DFN_",",.131,"E")
  1.  S CPN=$$GET1^DIQ(2,DFN_",",.134,"E")
  1.  S WPN=$$GET1^DIQ(2,DFN_",",.132,"E")
  1.  S EPN=$$GET1^DIQ(2,DFN_",",.339,"E")
  1.  S NPN=$$GET1^DIQ(2,DFN_",",.219,"E")
  1.  U 0 W "Patient: "_PTNAME,!
  1.  U 0 W "Before executing input string:",!
  1.  U 0 W ?5,"Home Phone: "_HPN,!
  1.  U 0 W ?5,"Cell Phone: "_CPN,!
  1.  U 0 W ?5,"Work Phone: "_WPN,!
  1.  U 0 W ?5,"Emergency Phone: "_EPN,!
  1.  U 0 W ?5,"NOK Phone: "_NPN,!!
  1.  Q
  1. AFTER ;
  1.  S (HPN,CPN,WPN,EPN,NPN)=""
  1.  S PTNAME=$$GET1^DIQ(2,DFN_",",.01,"E")
  1.  S HPN=$$GET1^DIQ(2,DFN_",",.131,"E")
  1.  S CPN=$$GET1^DIQ(2,DFN_",",.134,"E")
  1.  S WPN=$$GET1^DIQ(2,DFN_",",.132,"E")
  1.  S EPN=$$GET1^DIQ(2,DFN_",",.339,"E")
  1.  S NPN=$$GET1^DIQ(2,DFN_",",.219,"E")
  1.  U 0 W "After executing input string:",!
  1.  U 0 W "Patient: "_PTNAME,!
  1.  U 0 W ?5,"Home Phone: "_HPN,!
  1.  U 0 W ?5,"Cell Phone: "_CPN,!
  1.  U 0 W ?5,"Work Phone: "_WPN,!
  1.  U 0 W ?5,"Emergency Phone: "_EPN,!
  1.  U 0 W ?5,"NOK Phone: "_NPN
  1.  Q