DGV53PT6 ;ALB/MTC - MAS v5.3 Post Init Routine ; 07 JAN 93
;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
;
;
CON45 ;-- This routine will perform the conversion to file #200 for the
; PTF file (#45)
;
N RECNUM,SEQ,NODE,MULT,PROV,PREC,TREC,PSAV,OK
;-- get entry in File 43 for conversion of file 45
D ADDPC^DGV53PT1(45)
;-- determine if conversion needs to be re-started.
S PSAV=$O(^DG(43,1,"PCON","B",45,0)),PREC=$G(^DG(43,1,"PCON",+PSAV,0))
;-- quit if file is already converted
G:$P(PREC,U,6)="Y" CON45Q
;-- create entry in log file
D NEWFILE^DGV53PT1(45)
;-- if record already present then re-start
S OK=1 D REST45(PREC,PSAV)
;-- start of main loop
F S RECNUM=$O(^DGPT(RECNUM)) Q:'RECNUM S TREC=TREC+1 W:'(TREC#100) "." D
. ;-- get provider
. S PROV=$P($G(^DGPT(RECNUM,70)),U,15)
. ;-- save provider information
. S ^DG(43,1,"PCON",PSAV,0)=45_U_STIME_U_U_RECNUM_U_70_U_U_TREC_U_U_U_PROV
. ;-- update 70 node
. I PROV D PTF70(RECNUM,PROV)
. ;-- update <501> mulitiple
. S SEQ=0 F S SEQ=$O(^DGPT(RECNUM,"M",SEQ)) Q:'SEQ D
.. ;-- get provider
.. S PROV=$P($G(^DGPT(RECNUM,"M",SEQ,"P")),U,5)
.. ;-- save provider information
.. S ^DG(43,1,"PCON",PSAV,0)=45_U_STIME_U_U_RECNUM_U_"P"_U_U_TREC_U_"M"_U_SEQ_U_PROV
.. I PROV D PTFMP(RECNUM,SEQ,PROV)
;-- update conversion entry in file 43
D DONE^DGV53PT1(PSAV,TREC),COMFILE^DGV53PT1(45,OK)
CON45Q ;
Q
PTF70(RECNUM,PROV) ;-- process PTF '70' node
; INPUT : RECNUM - PTF Record Number to process
; PROV - Current Provider Pointer
;
N X,Y
S X=$G(^DIC(16,+PROV,"A3"))
I 'X S Y=">>> Provider fld. (79.1) for entry #"_RECNUM_" :'"_$P($G(^DIC(16,+PROV,0)),U)_"' could not be converted." S OK=0 D WRERROR^DGV53PT1(Y)
S DR="79.1////"_$S(X:X,1:"@"),DIE="^DGPT(",DA=RECNUM D ^DIE K DA,DIE,DR
Q
;
PTFMP(RECNUM,SEQ,PROV) ;-- process PTF '501' multiple
; INPUT :RENUM - PTF Record Number to process
; SEQ - Sequence Number in <501> multiple
; PROV - Current Provider Pointer
;
N X,Y
S X=$G(^DIC(16,+PROV,"A3"))
I 'X S Y=">>> <501> #"_SEQ_" Provider fld. (24) for entry #"_RECNUM_" :'"_$P($G(^DIC(16,+PROV,0)),U)_"' could not be converted." S OK=0 D WRERROR^DGV53PT1(Y)
S DR="24////"_$S(X:X,1:"@"),DIE="^DGPT("_RECNUM_",""M"",",DA(1)=RECNUM,DA=SEQ D ^DIE K DIE,DA,DR
Q
;
REST45(PREC,PSAV) ;-- This tag will re-process the PTF entry incase the conversion
; needs to be re-started.
; INPUT : PREC - 0 Node of entry in MAS Parameter File for file 45
; PSAV - IFN of the entry in file 43
;-- 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),SEQ=+$P(PREC,U,9),TREC=+$P(PREC,U,7),CURPT=$P(PREC,U,10)
I 'RECNUM,'SEQ Q
;-- check if 70 node has been processed
S X=$P($G(^DGPT(RECNUM,70)),U,15)
I X,$P(PREC,U,10)=X,RECNUM,'NODE,'MULT,'SEQ D PTF70(RECNUM,X)
;-- check and process <501> multiple
S:SEQ X=$P($G(^DGPT(RECNUM,"M",SEQ,"P")),U,5)
I SEQ,X,$P(PREC,U,10)=X D PTFMP(RENUM,SEQ,X)
F S SEQ=$O(^DGPT(RECNUM,"M",SEQ)) Q:'SEQ D
. ;-- get provider
. S X=$P($G(^DGPT(RECNUM,"M",SEQ,"P")),U,5)
. ;-- save provider information
. S ^DG(43,1,"PCON",PSAV,0)=45_U_STIME_U_U_RECNUM_U_"P"_U_U_TREC_U_"M"_U_SEQ_U_X
. I X D PTFMP(RECNUM,SEQ,X)
Q
;
DGV53PT6 ;ALB/MTC - MAS v5.3 Post Init Routine ; 07 JAN 93
+1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;
CON45 ;-- This routine will perform the conversion to file #200 for the
+1 ; PTF file (#45)
+2 ;
+3 NEW RECNUM,SEQ,NODE,MULT,PROV,PREC,TREC,PSAV,OK
+4 ;-- get entry in File 43 for conversion of file 45
+5 DO ADDPC^DGV53PT1(45)
+6 ;-- determine if conversion needs to be re-started.
+7 SET PSAV=$ORDER(^DG(43,1,"PCON","B",45,0))
SET PREC=$GET(^DG(43,1,"PCON",+PSAV,0))
+8 ;-- quit if file is already converted
+9 IF $PIECE(PREC,U,6)="Y"
GOTO CON45Q
+10 ;-- create entry in log file
+11 DO NEWFILE^DGV53PT1(45)
+12 ;-- if record already present then re-start
+13 SET OK=1
DO REST45(PREC,PSAV)
+14 ;-- start of main loop
+15 FOR
SET RECNUM=$ORDER(^DGPT(RECNUM))
IF 'RECNUM
QUIT
SET TREC=TREC+1
IF '(TREC#100)
WRITE "."
Begin DoDot:1
+16 ;-- get provider
+17 SET PROV=$PIECE($GET(^DGPT(RECNUM,70)),U,15)
+18 ;-- save provider information
+19 SET ^DG(43,1,"PCON",PSAV,0)=45_U_STIME_U_U_RECNUM_U_70_U_U_TREC_U_U_U_PROV
+20 ;-- update 70 node
+21 IF PROV
DO PTF70(RECNUM,PROV)
+22 ;-- update <501> mulitiple
+23 SET SEQ=0
FOR
SET SEQ=$ORDER(^DGPT(RECNUM,"M",SEQ))
IF 'SEQ
QUIT
Begin DoDot:2
+24 ;-- get provider
+25 SET PROV=$PIECE($GET(^DGPT(RECNUM,"M",SEQ,"P")),U,5)
+26 ;-- save provider information
+27 SET ^DG(43,1,"PCON",PSAV,0)=45_U_STIME_U_U_RECNUM_U_"P"_U_U_TREC_U_"M"_U_SEQ_U_PROV
+28 IF PROV
DO PTFMP(RECNUM,SEQ,PROV)
End DoDot:2
End DoDot:1
+29 ;-- update conversion entry in file 43
+30 DO DONE^DGV53PT1(PSAV,TREC)
DO COMFILE^DGV53PT1(45,OK)
CON45Q ;
+1 QUIT
PTF70(RECNUM,PROV) ;-- process PTF '70' node
+1 ; INPUT : RECNUM - PTF 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=">>> Provider fld. (79.1) for entry #"_RECNUM_" :'"_$PIECE($GET(^DIC(16,+PROV,0)),U)_"' could not be converted."
SET OK=0
DO WRERROR^DGV53PT1(Y)
+7 SET DR="79.1////"_$SELECT(X:X,1:"@")
SET DIE="^DGPT("
SET DA=RECNUM
DO ^DIE
KILL DA,DIE,DR
+8 QUIT
+9 ;
PTFMP(RECNUM,SEQ,PROV) ;-- process PTF '501' multiple
+1 ; INPUT :RENUM - PTF Record Number to process
+2 ; SEQ - Sequence Number in <501> multiple
+3 ; PROV - Current Provider Pointer
+4 ;
+5 NEW X,Y
+6 SET X=$GET(^DIC(16,+PROV,"A3"))
+7 IF 'X
SET Y=">>> <501> #"_SEQ_" Provider fld. (24) for entry #"_RECNUM_" :'"_$PIECE($GET(^DIC(16,+PROV,0)),U)_"' could not be converted."
SET OK=0
DO WRERROR^DGV53PT1(Y)
+8 SET DR="24////"_$SELECT(X:X,1:"@")
SET DIE="^DGPT("_RECNUM_",""M"","
SET DA(1)=RECNUM
SET DA=SEQ
DO ^DIE
KILL DIE,DA,DR
+9 QUIT
+10 ;
REST45(PREC,PSAV) ;-- This tag will re-process the PTF entry incase the conversion
+1 ; needs to be re-started.
+2 ; INPUT : PREC - 0 Node of entry in MAS Parameter File for file 45
+3 ; PSAV - IFN of the entry in file 43
+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 SEQ=+$PIECE(PREC,U,9)
SET TREC=+$PIECE(PREC,U,7)
SET CURPT=$PIECE(PREC,U,10)
+7 IF 'RECNUM
IF 'SEQ
QUIT
+8 ;-- check if 70 node has been processed
+9 SET X=$PIECE($GET(^DGPT(RECNUM,70)),U,15)
+10 IF X
IF $PIECE(PREC,U,10)=X
IF RECNUM
IF 'NODE
IF 'MULT
IF 'SEQ
DO PTF70(RECNUM,X)
+11 ;-- check and process <501> multiple
+12 IF SEQ
SET X=$PIECE($GET(^DGPT(RECNUM,"M",SEQ,"P")),U,5)
+13 IF SEQ
IF X
IF $PIECE(PREC,U,10)=X
DO PTFMP(RENUM,SEQ,X)
+14 FOR
SET SEQ=$ORDER(^DGPT(RECNUM,"M",SEQ))
IF 'SEQ
QUIT
Begin DoDot:1
+15 ;-- get provider
+16 SET X=$PIECE($GET(^DGPT(RECNUM,"M",SEQ,"P")),U,5)
+17 ;-- save provider information
+18 SET ^DG(43,1,"PCON",PSAV,0)=45_U_STIME_U_U_RECNUM_U_"P"_U_U_TREC_U_"M"_U_SEQ_U_X
+19 IF X
DO PTFMP(RECNUM,SEQ,X)
End DoDot:1
+20 QUIT
+21 ;
