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