- 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 ;