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

DGV53PT4.m

Go to the documentation of this file. 
  1. DGV53PT4 ;MTC/ALB - Provider Conversion Continued ; 21 JAN 93
  1.  ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
  1.  ;
  1. CON457 ;-- This routine will perform the conversion to file #200 for the
  1.  ;   Facility Treating Specialty (#45.7)
  1.  ;
  1.  N RECNUM,SEQ,NODE,MULT,PROV,PREC,TREC,PSAV,OK
  1.  ;-- get entry in File 43 for conversion of file 45.7
  1.  D ADDPC^DGV53PT1(45.7)
  1.  ;-- determine if conversion needs to be re-started.
  1.  S PSAV=$O(^DG(43,1,"PCON","B",45.7,0)),PREC=$G(^DG(43,1,"PCON",+PSAV,0))
  1.  ;-- quit if file is already converted
  1.  G:$P(PREC,U,6)="Y" CON457Q
  1.  ;-- create entry in log file
  1.  D NEWFILE^DGV53PT1(45.7)
  1.  ;-- if record already present then re-start
  1.  S OK=1 D REST457(PREC,PSAV)
  1.  ;-- start of main loop
  1.  F  S RECNUM=$O(^DIC(45.7,RECNUM)) Q:'RECNUM  S TREC=TREC+1 W:'(TREC#100) "." D
  1.  . ;-- update 'PRO' mulitiple
  1.  . S SEQ=0 F  S SEQ=$O(^DIC(45.7,RECNUM,"PRO",SEQ)) Q:'SEQ  D
  1.  .. ;-- get provider
  1.  .. S PROV=$P($G(^DIC(45.7,RECNUM,"PRO",SEQ,0)),U)
  1.  .. ;-- save provider information
  1.  .. S ^DG(43,1,"PCON",PSAV,0)=45.7_U_STIME_U_U_RECNUM_U_U_U_TREC_U_"PRO"_U_SEQ_U_PROV
  1.  .. I PROV D DIC457(RECNUM,SEQ,PROV)
  1.  ;-- update conversion entry in file 43
  1.  D DONE^DGV53PT1(PSAV,TREC),COMFILE^DGV53PT1(45.7,OK)
  1. CON457Q ;
  1.  Q
  1. DIC457(RECNUM,SEQ,PROV) ;-- process PTF 'PRO' multiple
  1.  ; INPUT :RENUM - PTF Record Number to process
  1.  ;        SEQ   - Sequence Number in 'PRO' multiple
  1.  ;        PROV  - Current Provider Pointer
  1.  ;
  1.  N X,Y
  1.  S X=$G(^DIC(16,+PROV,"A3"))
  1.  I 'X S Y=">>> Provider fld. (10) for seq. #"_SEQ_" in entry #"_RECNUM_" :'"_$P($G(^DIC(16,+PROV,0)),U)_"' could not be converted." S OK=0 D WRERROR^DGV53PT1(Y)
  1.  S DR=".01////"_$S(X:X,1:"@"),DIE="^DIC(45.7,"_RECNUM_",""PRO"",",DA(1)=RECNUM,DA=SEQ D ^DIE K DIE,DA,DR
  1.  Q
  1.  ;
  1. REST457(PREC,PSAV) ;-- This tag will re-process the PTF entry incase the conversion
  1.  ;   needs to be re-started.
  1.  ;  INPUT : PREC - 0 Node of entry in MAS Parameter File for file 45.7
  1.  ;          PSAV - IFN of the entry in file 43
  1.  ;-- get starting point
  1.  I '$P(PREC,U,2) D NOW^%DTC S $P(^DG(43,1,"PCON",PSAV,0),U,2)=%
  1.  S STIME=$P(^DG(43,1,"PCON",PSAV,0),U,2),RECNUM=+$P(PREC,U,4),MULT=$P(PREC,U,8),NODE=$P(PREC,U,5),SEQ=+$P(PREC,U,9),TREC=+$P(PREC,U,7),CURPT=$P(PREC,U,10)
  1.  I 'RECNUM,'SEQ Q
  1.  ;-- check and process 'PRO' multiple
  1.  S:SEQ X=$P($G(^DIC(45.7,RECNUM,"PRO",SEQ,0)),U)
  1.  I SEQ,X,$P(PREC,U,10)=X D DIC457(RECNUM,SEQ,X)
  1.  F  S SEQ=$O(^DIC(45.7,RECNUM,"PRO",SEQ)) Q:'SEQ  D
  1.  . ;-- get provider
  1.  . S PROV=$P($G(^DIC(45.7,RECNUM,"PRO",SEQ,0)),U)
  1.  . ;-- save provider information
  1.  . S ^DG(43,1,"PCON",PSAV,0)=45.7_U_STIME_U_U_RECNUM_U_U_U_TREC_U_"PRO"_U_SEQ_U_PROV
  1.  . I PROV D DIC457(RECNUM,SEQ,PROV)
  1.  Q
  1.  ;
  1. CON392 ;-- This routine will perform the conversion to file #200 for the
  1.  ;   Benificiary Travel Claim File (#392)
  1.  ;
  1.  N RECNUM,SEQ,NODE,MULT,PROV,PREC,TREC,PSAV,STIME,OK
  1.  ;-- get entry in File 43 for conversion of file 392
  1.  D ADDPC^DGV53PT1(392)
  1.  ;-- determine if conversion needs to be re-started.
  1.  S PSAV=$O(^DG(43,1,"PCON","B",392,0)),PREC=$G(^DG(43,1,"PCON",+PSAV,0))
  1.  ;-- quit if file is already converted
  1.  G:$P(PREC,U,6)="Y" CON392Q
  1.  ;-- create entry in log file
  1.  D NEWFILE^DGV53PT1(392)
  1.  ;-- if record already present then re-start
  1.  S OK=1 D REST392(PREC,PSAV)
  1.  ;-- start of main loop
  1.  F  S RECNUM=$O(^DGBT(392,RECNUM)) Q:'RECNUM  S TREC=TREC+1 W:'(TREC#100) "." D
  1.  . ;-- get provider
  1.  . S PROV=$P($G(^DGBT(392,RECNUM,"A")),U)
  1.  . ;-- save provider information from piece 1 of "A" node
  1.  . S ^DG(43,1,"PCON",PSAV,0)=392_U_STIME_U_U_RECNUM_U_"A"_U_U_TREC_U_U_U_PROV
  1.  . ;-- update 41 field of node "A"
  1.  . I PROV D DGBT392(RECNUM,PROV)
  1.  ;-- enter completion time, mark conversion as completed
  1.  D DONE^DGV53PT1(PSAV,TREC),COMFILE^DGV53PT1(392,OK)
  1. CON392Q ;-- exit
  1.  Q
  1.  ;
  1. DGBT392(RECNUM,PROV) ;-- process ^DGBT field 41
  1.  ; INPUT : RECNUM - Record Number to process
  1.  ;         PROV   - Current Provider Pointer
  1.  ;
  1.  N X,Y
  1.  Q:'PROV
  1.  S X=$G(^DIC(16,+PROV,"A3"))
  1.  I 'X S Y=">>> Authorizing Person fld. (41) for entry #"_RECNUM_" :'"_$P($G(^DIC(16,+PROV,0)),U)_"' could not be converted." S OK=0 D WRERROR^DGV53PT1(Y)
  1.  S DR="41////"_$S(X:X,1:"@"),DIE="^DGBT(392,",DA=RECNUM D ^DIE K DA,DIE,DR
  1.  Q
  1.  ;
  1. REST392(PREC,PSAV) ;-- This tag will re-process the entry incase the conversion
  1.  ;   needs to be re-started.
  1.  ;  INPUT : PREC - 0 Node of entry in MAS Parameter File for file 392
  1.  ;
  1.  ;-- get starting point
  1.  I '$P(PREC,U,2) D NOW^%DTC S $P(^DG(43,1,"PCON",PSAV,0),U,2)=%
  1.  S STIME=$P(^DG(43,1,"PCON",PSAV,0),U,2),RECNUM=+$P(PREC,U,4),MULT=$P(PREC,U,8),NODE=$P(PREC,U,5),SEQ=+$P(PREC,U,9),TREC=+$P(PREC,U,7),CURPT=$P(PREC,U,10)
  1.  I 'RECNUM Q
  1.  ;-- check if provider field has been processed
  1.  S X=$P($G(^DGBT(392,RECNUM,"A")),U)
  1.  I X,$P(PREC,U,10)=X D DGBT392(RECNUM,X)
  1.  Q
  1.  ;