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

DG53251P.m

Go to the documentation of this file.
  1. DG53251P ;BPCIOFO/ACS-UPDATE PLACE OF DISP FILE ;10/06/1999
  1. ;;5.3;REGISTRATION;**251,1015**;AUG 13, 1993;Build 21
  1. ;-----------------------------------------------------------------
  1. ; P L A C E O F D I S P O S I T I O N (P.O.D) U P D A T E
  1. ;
  1. ; PURPOSE ADD 3 NEW ENTRIES (M,Y,Z) TO THE P.O.D. FILE AND
  1. ; EDIT EXISTING ENTRY "P"
  1. ;
  1. ; ACTION CODE NAME TYPE OF CARE
  1. ; ------ ---- --------------------------------------- ------------
  1. ; ADD M REFER VA-PD HOME/COMMUNITY HEALTH C
  1. ; ADD Y REFER MEDICARE HOME HEALTH CARE C
  1. ; ADD Z REFER OTHER AGENCY-PD HOME HEALTH CARE C
  1. ; UPDATE P HOME-BASED PRIMARY CARE (HBPC) C
  1. ;
  1. ;
  1. ; INPUT VARIABLES - NONE
  1. ; OUTPUT VARIABLES - NONE
  1. ; INPUT ARRAYS - NONE
  1. ; OUTPUT ARRAYS - NONE
  1. ;
  1. ; LOCAL VARIABLES
  1. ; - CODE => CODE (FIELD #2) IN P.O.D. FILE
  1. ; - ENTRIES => NUMBER OF ENTRIES FOUND IN P.O.D. FILE
  1. ; - FILE => P.O.D. FILE #45.6
  1. ; - TAG => "ADD" OR "REPLACE" line tag
  1. ; - IEN => IEN of new or existing file entry
  1. ;
  1. ; LOCAL ARRAYS
  1. ; - FDA($J) => FDA root containing P.O.D. data
  1. ; - ^TMP("DILIST") => contains data returned from FIND^DIC
  1. ;
  1. ; EXTERNAL CALLS
  1. ; - FIND^DIC CHECK IF ENTRY EXISTS
  1. ; - UPDATE^DIE ADD NEW ENTRY
  1. ; - FILE^DIE REPLACE EXISTING ENTRY
  1. ;
  1. ; NOTE: IF ENTRIES M, Y, OR Z ALREADY EXIST, THEN THE DATA WILL BE
  1. ; OVERWRITTEN. IF ENTRY P DOESN'T EXIST, THEN IT WILL BE
  1. ; ADDED
  1. ;
  1. ;---------------------------------------------------------------
  1. ;
  1. MAIN ;-See if entries already exist and process the entry
  1. N N,CODE,ENTRIES,FILE,TAG
  1. S N=0,FILE=45.6
  1. F CODE="M","Y","Z","P" D
  1. .N IEN
  1. .K FDA($J)
  1. .D FIND^DIC(FILE,,,"OQ",CODE,,"C",,,,)
  1. .S ENTRIES=+$P(^TMP("DILIST",$J,0),"^",1)
  1. .D FDAROOT
  1. .; TAG=LINE TAG, "REPLACE" OR "ADD"
  1. .D @TAG
  1. .Q
  1. Q
  1. ;
  1. FDAROOT ; Get IEN and set up FDA root file
  1. ;
  1. ;-Get IEN and determine if entry will be added or replaced
  1. I ENTRIES>0 D
  1. .S IEN=$G(^TMP("DILIST",$J,"2",1))_","
  1. .S TAG="REPLACE"
  1. I ENTRIES'>0 D
  1. .S IEN="?+1,"
  1. .S TAG="ADD"
  1. ;-Set up FDA root file
  1. I CODE="M" D Q
  1. .S FDA($J,FILE,IEN,.01)="REFER VA-PD HOME/COMMUNITY HEALTH"
  1. .S FDA($J,FILE,IEN,2)=CODE
  1. .S FDA($J,FILE,IEN,3)="C"
  1. I CODE="Y" D Q
  1. .S FDA($J,FILE,IEN,.01)="REFER MEDICARE HOME HEALTH CARE"
  1. .S FDA($J,FILE,IEN,2)=CODE
  1. .S FDA($J,FILE,IEN,3)="C"
  1. I CODE="Z" D Q
  1. .S FDA($J,FILE,IEN,.01)="REFER OTHER AGENCY-PD HOME HEALTH CARE"
  1. .S FDA($J,FILE,IEN,2)=CODE
  1. .S FDA($J,FILE,IEN,3)="C"
  1. I CODE="P" D Q
  1. .S FDA($J,FILE,IEN,.01)="HOME-BASED PRIMARY CARE (HBPC)"
  1. .;-If entry "P" not found, add all fields to FDA root file
  1. .I ENTRIES'>0 D Q
  1. ..S FDA($J,FILE,IEN,2)=CODE
  1. ..S FDA($J,FILE,IEN,3)="C"
  1. Q
  1. ;
  1. REPLACE ;-Replace entry with new data
  1. D FILE^DIE("E","FDA($J)")
  1. Q
  1. ;
  1. ADD ;-Add entry to file
  1. D UPDATE^DIE("E","FDA($J)")
  1. Q