DG53251P ;BPCIOFO/ACS-UPDATE PLACE OF DISP FILE ;10/06/1999
;;5.3;REGISTRATION;**251**;AUG 13, 1993
;-----------------------------------------------------------------
; 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
;
; PURPOSE ADD 3 NEW ENTRIES (M,Y,Z) TO THE P.O.D. FILE AND
; EDIT EXISTING ENTRY "P"
;
; ACTION CODE NAME TYPE OF CARE
; ------ ---- --------------------------------------- ------------
; ADD M REFER VA-PD HOME/COMMUNITY HEALTH C
; ADD Y REFER MEDICARE HOME HEALTH CARE C
; ADD Z REFER OTHER AGENCY-PD HOME HEALTH CARE C
; UPDATE P HOME-BASED PRIMARY CARE (HBPC) C
;
;
; INPUT VARIABLES - NONE
; OUTPUT VARIABLES - NONE
; INPUT ARRAYS - NONE
; OUTPUT ARRAYS - NONE
;
; LOCAL VARIABLES
; - CODE => CODE (FIELD #2) IN P.O.D. FILE
; - ENTRIES => NUMBER OF ENTRIES FOUND IN P.O.D. FILE
; - FILE => P.O.D. FILE #45.6
; - TAG => "ADD" OR "REPLACE" line tag
; - IEN => IEN of new or existing file entry
;
; LOCAL ARRAYS
; - FDA($J) => FDA root containing P.O.D. data
; - ^TMP("DILIST") => contains data returned from FIND^DIC
;
; EXTERNAL CALLS
; - FIND^DIC CHECK IF ENTRY EXISTS
; - UPDATE^DIE ADD NEW ENTRY
; - FILE^DIE REPLACE EXISTING ENTRY
;
; NOTE: IF ENTRIES M, Y, OR Z ALREADY EXIST, THEN THE DATA WILL BE
; OVERWRITTEN. IF ENTRY P DOESN'T EXIST, THEN IT WILL BE
; ADDED
;
;---------------------------------------------------------------
;
MAIN ;-See if entries already exist and process the entry
N N,CODE,ENTRIES,FILE,TAG
S N=0,FILE=45.6
F CODE="M","Y","Z","P" D
.N IEN
.K FDA($J)
.D FIND^DIC(FILE,,,"OQ",CODE,,"C",,,,)
.S ENTRIES=+$P(^TMP("DILIST",$J,0),"^",1)
.D FDAROOT
.; TAG=LINE TAG, "REPLACE" OR "ADD"
.D @TAG
.Q
Q
;
FDAROOT ; Get IEN and set up FDA root file
;
;-Get IEN and determine if entry will be added or replaced
I ENTRIES>0 D
.S IEN=$G(^TMP("DILIST",$J,"2",1))_","
.S TAG="REPLACE"
I ENTRIES'>0 D
.S IEN="?+1,"
.S TAG="ADD"
;-Set up FDA root file
I CODE="M" D Q
.S FDA($J,FILE,IEN,.01)="REFER VA-PD HOME/COMMUNITY HEALTH"
.S FDA($J,FILE,IEN,2)=CODE
.S FDA($J,FILE,IEN,3)="C"
I CODE="Y" D Q
.S FDA($J,FILE,IEN,.01)="REFER MEDICARE HOME HEALTH CARE"
.S FDA($J,FILE,IEN,2)=CODE
.S FDA($J,FILE,IEN,3)="C"
I CODE="Z" D Q
.S FDA($J,FILE,IEN,.01)="REFER OTHER AGENCY-PD HOME HEALTH CARE"
.S FDA($J,FILE,IEN,2)=CODE
.S FDA($J,FILE,IEN,3)="C"
I CODE="P" D Q
.S FDA($J,FILE,IEN,.01)="HOME-BASED PRIMARY CARE (HBPC)"
.;-If entry "P" not found, add all fields to FDA root file
.I ENTRIES'>0 D Q
..S FDA($J,FILE,IEN,2)=CODE
..S FDA($J,FILE,IEN,3)="C"
Q
;
REPLACE ;-Replace entry with new data
D FILE^DIE("E","FDA($J)")
Q
;
ADD ;-Add entry to file
D UPDATE^DIE("E","FDA($J)")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53251P 3085 printed Dec 13, 2024@02:36:52 Page 2
DG53251P ;BPCIOFO/ACS-UPDATE PLACE OF DISP FILE ;10/06/1999
+1 ;;5.3;REGISTRATION;**251**;AUG 13, 1993
+2 ;-----------------------------------------------------------------
+3 ; 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
+4 ;
+5 ; PURPOSE ADD 3 NEW ENTRIES (M,Y,Z) TO THE P.O.D. FILE AND
+6 ; EDIT EXISTING ENTRY "P"
+7 ;
+8 ; ACTION CODE NAME TYPE OF CARE
+9 ; ------ ---- --------------------------------------- ------------
+10 ; ADD M REFER VA-PD HOME/COMMUNITY HEALTH C
+11 ; ADD Y REFER MEDICARE HOME HEALTH CARE C
+12 ; ADD Z REFER OTHER AGENCY-PD HOME HEALTH CARE C
+13 ; UPDATE P HOME-BASED PRIMARY CARE (HBPC) C
+14 ;
+15 ;
+16 ; INPUT VARIABLES - NONE
+17 ; OUTPUT VARIABLES - NONE
+18 ; INPUT ARRAYS - NONE
+19 ; OUTPUT ARRAYS - NONE
+20 ;
+21 ; LOCAL VARIABLES
+22 ; - CODE => CODE (FIELD #2) IN P.O.D. FILE
+23 ; - ENTRIES => NUMBER OF ENTRIES FOUND IN P.O.D. FILE
+24 ; - FILE => P.O.D. FILE #45.6
+25 ; - TAG => "ADD" OR "REPLACE" line tag
+26 ; - IEN => IEN of new or existing file entry
+27 ;
+28 ; LOCAL ARRAYS
+29 ; - FDA($J) => FDA root containing P.O.D. data
+30 ; - ^TMP("DILIST") => contains data returned from FIND^DIC
+31 ;
+32 ; EXTERNAL CALLS
+33 ; - FIND^DIC CHECK IF ENTRY EXISTS
+34 ; - UPDATE^DIE ADD NEW ENTRY
+35 ; - FILE^DIE REPLACE EXISTING ENTRY
+36 ;
+37 ; NOTE: IF ENTRIES M, Y, OR Z ALREADY EXIST, THEN THE DATA WILL BE
+38 ; OVERWRITTEN. IF ENTRY P DOESN'T EXIST, THEN IT WILL BE
+39 ; ADDED
+40 ;
+41 ;---------------------------------------------------------------
+42 ;
MAIN ;-See if entries already exist and process the entry
+1 NEW N,CODE,ENTRIES,FILE,TAG
+2 SET N=0
SET FILE=45.6
+3 FOR CODE="M","Y","Z","P"
Begin DoDot:1
+4 NEW IEN
+5 KILL FDA($JOB)
+6 DO FIND^DIC(FILE,,,"OQ",CODE,,"C",,,,)
+7 SET ENTRIES=+$PIECE(^TMP("DILIST",$JOB,0),"^",1)
+8 DO FDAROOT
+9 ; TAG=LINE TAG, "REPLACE" OR "ADD"
+10 DO @TAG
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
FDAROOT ; Get IEN and set up FDA root file
+1 ;
+2 ;-Get IEN and determine if entry will be added or replaced
+3 IF ENTRIES>0
Begin DoDot:1
+4 SET IEN=$GET(^TMP("DILIST",$JOB,"2",1))_","
+5 SET TAG="REPLACE"
End DoDot:1
+6 IF ENTRIES'>0
Begin DoDot:1
+7 SET IEN="?+1,"
+8 SET TAG="ADD"
End DoDot:1
+9 ;-Set up FDA root file
+10 IF CODE="M"
Begin DoDot:1
+11 SET FDA($JOB,FILE,IEN,.01)="REFER VA-PD HOME/COMMUNITY HEALTH"
+12 SET FDA($JOB,FILE,IEN,2)=CODE
+13 SET FDA($JOB,FILE,IEN,3)="C"
End DoDot:1
QUIT
+14 IF CODE="Y"
Begin DoDot:1
+15 SET FDA($JOB,FILE,IEN,.01)="REFER MEDICARE HOME HEALTH CARE"
+16 SET FDA($JOB,FILE,IEN,2)=CODE
+17 SET FDA($JOB,FILE,IEN,3)="C"
End DoDot:1
QUIT
+18 IF CODE="Z"
Begin DoDot:1
+19 SET FDA($JOB,FILE,IEN,.01)="REFER OTHER AGENCY-PD HOME HEALTH CARE"
+20 SET FDA($JOB,FILE,IEN,2)=CODE
+21 SET FDA($JOB,FILE,IEN,3)="C"
End DoDot:1
QUIT
+22 IF CODE="P"
Begin DoDot:1
+23 SET FDA($JOB,FILE,IEN,.01)="HOME-BASED PRIMARY CARE (HBPC)"
+24 ;-If entry "P" not found, add all fields to FDA root file
+25 IF ENTRIES'>0
Begin DoDot:2
+26 SET FDA($JOB,FILE,IEN,2)=CODE
+27 SET FDA($JOB,FILE,IEN,3)="C"
End DoDot:2
QUIT
End DoDot:1
QUIT
+28 QUIT
+29 ;
REPLACE ;-Replace entry with new data
+1 DO FILE^DIE("E","FDA($J)")
+2 QUIT
+3 ;
ADD ;-Add entry to file
+1 DO UPDATE^DIE("E","FDA($J)")
+2 QUIT
