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

DGV53PT3.m

Go to the documentation of this file.
  1. DGV53PT3 ;ALB/MTC - MAS v5.3 Post Init Routine ; 07 JAN 93
  1. ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
  1. ;
  1. CON405 ;-- This routine will perform the conversion to file #200 for the
  1. ; Patient Movement File (#405)
  1. ;
  1. N RECNUM,SEQ,NODE,MULT,PROV,PREC,TREC,PSAV,OK,REC,DGPMT,DATE
  1. ;-- set DGPMT to avoid setting x-refs in patient file
  1. S DGPMT=1
  1. ;-- get entry in File 43 for conversion of file 405
  1. D ADDPC^DGV53PT1(405)
  1. ;-- determine if conversion needs to be re-started.
  1. S PSAV=$O(^DG(43,1,"PCON","B",405,0)),PREC=$G(^DG(43,1,"PCON",+PSAV,0))
  1. ;-- quit if file is already converted
  1. G:$P(PREC,U,6)="Y" CON405Q
  1. ;-- create log file entry
  1. D NEWFILE^DGV53PT1(405)
  1. ;-- if record already present then re-start
  1. S OK=1 D REST405(PREC,PSAV)
  1. ;-- start of main loop
  1. F S DATE=$O(^DGPM("ATT6",DATE)) Q:'DATE S RECNUM=0 F S RECNUM=$O(^DGPM("ATT6",DATE,RECNUM)) Q:'RECNUM S TREC=TREC+1,REC=$G(^DGPM(RECNUM,0)) W:'(TREC#100) "." D UPDT
  1. ;-- enter completion time, mark conversion as completed
  1. D DONE^DGV53PT1(PSAV,TREC),COMFILE^DGV53PT1(405,OK)
  1. CON405Q ;-- exit
  1. Q
  1. ;
  1. DGPM08(RECNUM,PROV) ;-- process DGPM '.08' field of the 0 node
  1. ; INPUT : RECNUM - Record Number to process
  1. ; PROV - Current Provider Pointer
  1. ;
  1. N X,Y
  1. S X=$G(^DIC(16,+PROV,"A3"))
  1. I 'X S Y=">>> Primary Care Physician fld. (.08) for entry #"_RECNUM_" :'"_$P($G(^DIC(16,+PROV,0)),U)_"' could not be converted." S OK=0 D WRERROR^DGV53PT1(Y)
  1. S DR=".08////"_$S(X:X,1:"@"),DIE="^DGPM(",DA=RECNUM D ^DIE K DA,DIE,DR
  1. Q
  1. ;
  1. DGPM19(RECNUM,PROV) ;-- process DGPM '.19' field of the 0 node
  1. ; INPUT : RECNUM - Record Number to process
  1. ; PROV - Current Provider Pointer
  1. ;
  1. N X,Y
  1. S X=$G(^DIC(16,+PROV,"A3"))
  1. I 'X S Y=">>> Attending Physician fld. (.19) for entry #"_RECNUM_" :'"_$P($G(^DIC(16,+PROV,0)),U)_"' could not be converted." S OK=0 D WRERROR^DGV53PT1(Y)
  1. S DR=".19////"_$S(X:X,1:"@"),DIE="^DGPM(",DA=RECNUM D ^DIE K DA,DIE,DR
  1. Q
  1. ;
  1. REST405(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 405
  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),DATE=+$P(PREC,U,9),TREC=+$P(PREC,U,7),CURPT=$P(PREC,U,10)
  1. ;-- if no date then exit
  1. I 'DATE Q
  1. ;-- check if record was processed
  1. ;-- check if .08 field has been processed
  1. S X=$P($G(^DGPM(RECNUM,0)),U,8)
  1. I X,$P(PREC,U,10)=X,NODE=.08 D DGPM08(RECNUM,X)
  1. ;-- check if .19 field has been processed
  1. S X=$P($G(^DGPM(RECNUM,0)),U,19)
  1. I X,$P(PREC,U,10)=X,NODE=.19 D DGPM19(RECNUM,X)
  1. ;-- complete processing x-ref for date
  1. F S RECNUM=$O(^DGPM("ATT6",DATE,RECNUM)) Q:'RECNUM S REC=$G(^DGPM(RECNUM,0)) D UPDT
  1. Q
  1. ;
  1. UPDT ;-- This function will update the file 43 and 405
  1. ;
  1. ;-- get provider from 0 node
  1. S X=$P(REC,U,8)
  1. ;-- save provider information from piece 8 of 0 node
  1. S ^DG(43,1,"PCON",PSAV,0)=405_U_STIME_U_U_RECNUM_U_.08_U_U_TREC_U_U_DATE_U_X
  1. ;-- update .08 field of node 0
  1. I X D DGPM08(RECNUM,+X)
  1. ;-- get provider information from 19th piece of 0 node
  1. S X=$P(REC,U,19)
  1. ;-- save provider information
  1. S ^DG(43,1,"PCON",PSAV,0)=405_U_STIME_U_U_RECNUM_U_.19_U_U_TREC_U_U_DATE_U_X
  1. ;-- update
  1. I X D DGPM19(RECNUM,+X)
  1. Q
  1. ;