DGV53PTI ;MAF/ALB - CONVERSION TO UPDATE PHYSICIAN FOR DEFICIENCY IN THE FILE 393 14TH PIECE - SEP 21, 1992
;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
;PARAMETER CHECK
EN1 I '$D(^VAS(393,0)) D NOCON G Q
S DGJTDV=0 F S DGJTDV=$O(^DG(40.8,DGJTDV)) Q:DGJTDV']""!(+DGJTDV=0) I $D(^DG(40.8,DGJTDV,0)) I $D(^DG(40.8,DGJTDV,"DT")) D LIST
I $D(^UTILITY("VAS",$J)) W !,"***The following paramters need to be updated before the IRT conversion will run" D PRT,Q1
I '$D(^UTILITY("VAS",$J)) W !!!,"***ALL IRT PARAMETERS ARE UPDATED, THE IRT CONVERSION WILL START!" D EN
Q K %,DIC,DIE,DR,DA,DGJTNODE,DGJTADM,DGJATT,DGJPRIM,DGJRES,DGJT,DGJTPAR,DGJTPHDE,DGJSTAT,DGJTDV,DGJDV,DGJDTN,DGJFSIG,DGJY,DGJMSG,DGPGM,IFN,POP,X,^UTILITY("VAS",$J) Q
EN W !!,">POPULATING THE PHYSICIAN FOR DEFICIENCY FIELD FOR INCOMPLETE RECORDS TRACKING"
W !!,">UPDATING ATTENDING PHYSICIAN IF FACILITY USES ATTENDING PHYSICIAN AS A DEFAULT"
W !!,">>>IRT CONVERSION RUNNING"
F IFN=0:0 S IFN=$O(^VAS(393,IFN)) Q:'IFN I $D(^VAS(393,IFN,0)) S DGJTNODE=^VAS(393,IFN,0) D CK D FILE
W !!,">>>IRT CONVERSION COMPLETE" Q
Q1 W !!!,">>>THIS IRT CONVERSION CAN NOT CONTINUE WITHOUT UPDATING THE PARAMETERS!!",!!
W !,"PLEASE CONTACT YOUR MAS OFFICE AS TO HOW THE PARAMETERS SHOULD BE ANSWERED"
W !,"***TO UPDATE THE PARAMETERS RUN THE OPTION 'DGYP IRT UPDATE PARM' ",!?50,"(Update IRT Paramters)"
W !,"***THEN, RUN THE ROUTINE 'DGV53PTI' TO RUN THE IRT CONVERSION" Q
FILE Q:'$D(^VAS(393,IFN,0))
I $D(DGJUATT) S DR=".1////"_DGJUATT
S DIE="^VAS(393,",DA=IFN,DR=$S($D(DR):DR_";.14////"_DGJTPHDE,1:".14////"_DGJTPHDE) D ^DIE W:(IFN#5)=0 "." K DR,DGJUATT,DGJTPHDE Q
CK S DGJSTAT=$P(DGJTNODE,"^",11),DGJPRIM=$P(DGJTNODE,"^",9),DGJATT=$P(DGJTNODE,"^",10),DGJRES=$P(DGJTNODE,"^",12)
S DGJDV=$P(DGJTNODE,"^",6),DGJTPAR=$S($D(^DG(40.8,+DGJDV,"DT")):^DG(40.8,+DGJDV,"DT"),1:"") D:DGJATT']"" LTS S DGJFSIG=$S($P(DGJTPAR,"^",10)="P":DGJPRIM,$P(DGJTPAR,"^",10)="A":DGJATT,1:"")
S DGJDTN=$G(^VAS(393,IFN,"DT"))
I DGJSTAT=$O(^DG(393.2,"B","SIGNED NO REVIEW",0)) D S DGJTPHDE=X Q
.S X=$S($P(DGJDTN,"^",6)]"":$P(DGJDTN,"^",6),1:"")
I DGJSTAT=$O(^DG(393.2,"B","COMPLETED",0)) S DGJTPHDE=$S(DGJRES]"":DGJRES,1:DGJPRIM) Q
I DGJSTAT=$O(^DG(393.2,"B","REVIEWED",0)) D S DGJTPHDE=X Q
.S X=$S($P(DGJDTN,"^",8)]"":$P(DGJDTN,"^",8),1:"")
I DGJSTAT=$O(^DG(393.2,"B","DICTATED",0)) S DGJTPHDE=$S(DGJRES]"":DGJRES,1:DGJPRIM) Q
I DGJSTAT=$O(^DG(393.2,"B","TRANSCRIBED",0)) S DGJTPHDE=DGJFSIG Q
I DGJSTAT=$O(^DG(393.2,"B","INCOMPLETE",0)) S DGJTPHDE=$S(DGJRES]"":DGJRES,1:DGJPRIM) Q
I DGJSTAT=$O(^DG(393.2,"B","SIGNED",0)) S DGJTPHDE=DGJATT
I '$D(DGJTPHDE) S DGJTPHDE=""
Q
LTS Q:$P(DGJTNODE,"^",4)']""
Q:$P(DGJTPAR,"^",3)=0&($P(DGJTPAR,"^",10)="P")
S DGJT=$P(DGJTNODE,"^",4),DGJT=$O(^DGPM("ATS",$P(DGJTNODE,"^",1),DGJT,0)),DGJT=$O(^(+DGJT,0)),DGJT=$O(^(+DGJT,0)),DGJT=$S($D(^DGPM(+DGJT,0)):^(0),1:"") ;last TS mvt
I DGJATT']"" D S (DGJATT,DGJUATT)=X
.S DGJY=$S($P(DGJTPAR,"^",3)=1:4,$P(DGJTPAR,"^",3)=0:10,1:"") D DOC
Q
DOC ;provider resp.
S X=$P(DGJTPAR,"^",DGJY)
S X=$S(X="A":$P(DGJT,"^",19),X="P":$P(DGJT,"^",8),1:"")
Q
NOCON W !!!,"***THIS SITE IS NOT USING THE IRT PACKAGE. THIS IRT CONVERSION NEED NOT BE RUN**",!! Q
LIST S X=^DG(40.8,+DGJTDV,"DT") I $P(X,"^",2)']"" S $P(^UTILITY("VAS",$J,$P(^DG(40.8,DGJTDV,0),"^",1)),"^",1)=100.02
I $P(X,"^",3)']"" S $P(^UTILITY("VAS",$J,$P(^DG(40.8,DGJTDV,0),"^",1)),"^",2)=100.03
I $P(X,"^",3)=1,$P(X,"^",4)']"" S $P(^UTILITY("VAS",$J,$P(^DG(40.8,DGJTDV,0),"^",1)),"^",3)=100.04
I $P(X,"^",10)']"" S $P(^UTILITY("VAS",$J,$P(^DG(40.8,DGJTDV,0),"^",1)),"^",4)=100.1
Q
PRT S DGJTDV=0 F S DGJTDV=$O(^UTILITY("VAS",$J,DGJTDV)) Q:DGJTDV']"" I $D(^UTILITY("VAS",$J,DGJTDV)) S DGJTNODE=^UTILITY("VAS",$J,DGJTDV) D WRITE
Q
WRITE W !!,"DIVISION: "_DGJTDV
I $P(DGJTNODE,"^",1)]"" W !?5,$P(^DD(40.8,$P(DGJTNODE,"^",1),0),"^",1),?32," Choices: Primary or Attending Physician"
I $P(DGJTNODE,"^",2)]"" W !?5,$P(^DD(40.8,$P(DGJTNODE,"^",2),0),"^",1),?34," Choices: Yes or No",!?10,"If 'YES' the parameter DEFAULT REVIEWING PHYSICIAN will also be asked",!?32," Choices: Primary or Attending Physician"
I $P(DGJTNODE,"^",3)]"" W !?5,$P(^DD(40.8,$P(DGJTNODE,"^",3),0),"^",1),?32," Choices: Primary or Attending Physician"
I $P(DGJTNODE,"^",4)]"" W !?5,$P(^DD(40.8,$P(DGJTNODE,"^",4),0),"^",1)," Choices: Primary or Attending Physician"
Q
MSG W !!!,"***PLEASE CONTACT YOUR MAS OFFICE IF YOU HAVE ANY QUESTIONS AS TO HOW THE",!,"IRT PARAMETERS SHOULD BE ANSWERED!"
Q
DGV53PTI ;MAF/ALB - CONVERSION TO UPDATE PHYSICIAN FOR DEFICIENCY IN THE FILE 393 14TH PIECE - SEP 21, 1992
+1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
+2 ;PARAMETER CHECK
EN1 IF '$DATA(^VAS(393,0))
DO NOCON
GOTO Q
+1 SET DGJTDV=0
FOR
SET DGJTDV=$ORDER(^DG(40.8,DGJTDV))
IF DGJTDV']""!(+DGJTDV=0)
QUIT
IF $DATA(^DG(40.8,DGJTDV,0))
IF $DATA(^DG(40.8,DGJTDV,"DT"))
DO LIST
+2 IF $DATA(^UTILITY("VAS",$JOB))
WRITE !,"***The following paramters need to be updated before the IRT conversion will run"
DO PRT
DO Q1
+3 IF '$DATA(^UTILITY("VAS",$JOB))
WRITE !!!,"***ALL IRT PARAMETERS ARE UPDATED, THE IRT CONVERSION WILL START!"
DO EN
Q KILL %,DIC,DIE,DR,DA,DGJTNODE,DGJTADM,DGJATT,DGJPRIM,DGJRES,DGJT,DGJTPAR,DGJTPHDE,DGJSTAT,DGJTDV,DGJDV,DGJDTN,DGJFSIG,DGJY,DGJMSG,DGPGM,IFN,POP,X,^UTILITY("VAS",$JOB)
QUIT
EN WRITE !!,">POPULATING THE PHYSICIAN FOR DEFICIENCY FIELD FOR INCOMPLETE RECORDS TRACKING"
+1 WRITE !!,">UPDATING ATTENDING PHYSICIAN IF FACILITY USES ATTENDING PHYSICIAN AS A DEFAULT"
+2 WRITE !!,">>>IRT CONVERSION RUNNING"
+3 FOR IFN=0:0
SET IFN=$ORDER(^VAS(393,IFN))
IF 'IFN
QUIT
IF $DATA(^VAS(393,IFN,0))
SET DGJTNODE=^VAS(393,IFN,0)
DO CK
DO FILE
+4 WRITE !!,">>>IRT CONVERSION COMPLETE"
QUIT
Q1 WRITE !!!,">>>THIS IRT CONVERSION CAN NOT CONTINUE WITHOUT UPDATING THE PARAMETERS!!",!!
+1 WRITE !,"PLEASE CONTACT YOUR MAS OFFICE AS TO HOW THE PARAMETERS SHOULD BE ANSWERED"
+2 WRITE !,"***TO UPDATE THE PARAMETERS RUN THE OPTION 'DGYP IRT UPDATE PARM' ",!?50,"(Update IRT Paramters)"
+3 WRITE !,"***THEN, RUN THE ROUTINE 'DGV53PTI' TO RUN THE IRT CONVERSION"
QUIT
FILE IF '$DATA(^VAS(393,IFN,0))
QUIT
+1 IF $DATA(DGJUATT)
SET DR=".1////"_DGJUATT
+2 SET DIE="^VAS(393,"
SET DA=IFN
SET DR=$SELECT($DATA(DR):DR_";.14////"_DGJTPHDE,1:".14////"_DGJTPHDE)
DO ^DIE
IF (IFN#5)=0
WRITE "."
KILL DR,DGJUATT,DGJTPHDE
QUIT
CK SET DGJSTAT=$PIECE(DGJTNODE,"^",11)
SET DGJPRIM=$PIECE(DGJTNODE,"^",9)
SET DGJATT=$PIECE(DGJTNODE,"^",10)
SET DGJRES=$PIECE(DGJTNODE,"^",12)
+1 SET DGJDV=$PIECE(DGJTNODE,"^",6)
SET DGJTPAR=$SELECT($DATA(^DG(40.8,+DGJDV,"DT")):^DG(40.8,+DGJDV,"DT"),1:"")
IF DGJATT']""
DO LTS
SET DGJFSIG=$SELECT($PIECE(DGJTPAR,"^",10)="P":DGJPRIM,$PIECE(DGJTPAR,"^",10)="A":DGJATT,1:"")
+2 SET DGJDTN=$GET(^VAS(393,IFN,"DT"))
+3 IF DGJSTAT=$ORDER(^DG(393.2,"B","SIGNED NO REVIEW",0))
Begin DoDot:1
+4 SET X=$SELECT($PIECE(DGJDTN,"^",6)]"":$PIECE(DGJDTN,"^",6),1:"")
End DoDot:1
SET DGJTPHDE=X
QUIT
+5 IF DGJSTAT=$ORDER(^DG(393.2,"B","COMPLETED",0))
SET DGJTPHDE=$SELECT(DGJRES]"":DGJRES,1:DGJPRIM)
QUIT
+6 IF DGJSTAT=$ORDER(^DG(393.2,"B","REVIEWED",0))
Begin DoDot:1
+7 SET X=$SELECT($PIECE(DGJDTN,"^",8)]"":$PIECE(DGJDTN,"^",8),1:"")
End DoDot:1
SET DGJTPHDE=X
QUIT
+8 IF DGJSTAT=$ORDER(^DG(393.2,"B","DICTATED",0))
SET DGJTPHDE=$SELECT(DGJRES]"":DGJRES,1:DGJPRIM)
QUIT
+9 IF DGJSTAT=$ORDER(^DG(393.2,"B","TRANSCRIBED",0))
SET DGJTPHDE=DGJFSIG
QUIT
+10 IF DGJSTAT=$ORDER(^DG(393.2,"B","INCOMPLETE",0))
SET DGJTPHDE=$SELECT(DGJRES]"":DGJRES,1:DGJPRIM)
QUIT
+11 IF DGJSTAT=$ORDER(^DG(393.2,"B","SIGNED",0))
SET DGJTPHDE=DGJATT
+12 IF '$DATA(DGJTPHDE)
SET DGJTPHDE=""
+13 QUIT
LTS IF $PIECE(DGJTNODE,"^",4)']""
QUIT
+1 IF $PIECE(DGJTPAR,"^",3)=0&($PIECE(DGJTPAR,"^",10)="P")
QUIT
+2 ;last TS mvt
SET DGJT=$PIECE(DGJTNODE,"^",4)
SET DGJT=$ORDER(^DGPM("ATS",$PIECE(DGJTNODE,"^",1),DGJT,0))
SET DGJT=$ORDER(^(+DGJT,0))
SET DGJT=$ORDER(^(+DGJT,0))
SET DGJT=$SELECT($DATA(^DGPM(+DGJT,0)):^(0),1:"")
+3 IF DGJATT']""
Begin DoDot:1
+4 SET DGJY=$SELECT($PIECE(DGJTPAR,"^",3)=1:4,$PIECE(DGJTPAR,"^",3)=0:10,1:"")
DO DOC
End DoDot:1
SET (DGJATT,DGJUATT)=X
+5 QUIT
DOC ;provider resp.
+1 SET X=$PIECE(DGJTPAR,"^",DGJY)
+2 SET X=$SELECT(X="A":$PIECE(DGJT,"^",19),X="P":$PIECE(DGJT,"^",8),1:"")
+3 QUIT
NOCON WRITE !!!,"***THIS SITE IS NOT USING THE IRT PACKAGE. THIS IRT CONVERSION NEED NOT BE RUN**",!!
QUIT
LIST SET X=^DG(40.8,+DGJTDV,"DT")
IF $PIECE(X,"^",2)']""
SET $PIECE(^UTILITY("VAS",$JOB,$PIECE(^DG(40.8,DGJTDV,0),"^",1)),"^",1)=100.02
+1 IF $PIECE(X,"^",3)']""
SET $PIECE(^UTILITY("VAS",$JOB,$PIECE(^DG(40.8,DGJTDV,0),"^",1)),"^",2)=100.03
+2 IF $PIECE(X,"^",3)=1
IF $PIECE(X,"^",4)']""
SET $PIECE(^UTILITY("VAS",$JOB,$PIECE(^DG(40.8,DGJTDV,0),"^",1)),"^",3)=100.04
+3 IF $PIECE(X,"^",10)']""
SET $PIECE(^UTILITY("VAS",$JOB,$PIECE(^DG(40.8,DGJTDV,0),"^",1)),"^",4)=100.1
+4 QUIT
PRT SET DGJTDV=0
FOR
SET DGJTDV=$ORDER(^UTILITY("VAS",$JOB,DGJTDV))
IF DGJTDV']""
QUIT
IF $DATA(^UTILITY("VAS",$JOB,DGJTDV))
SET DGJTNODE=^UTILITY("VAS",$JOB,DGJTDV)
DO WRITE
+1 QUIT
WRITE WRITE !!,"DIVISION: "_DGJTDV
+1 IF $PIECE(DGJTNODE,"^",1)]""
WRITE !?5,$PIECE(^DD(40.8,$PIECE(DGJTNODE,"^",1),0),"^",1),?32," Choices: Primary or Attending Physician"
+2 IF $PIECE(DGJTNODE,"^",2)]""
WRITE !?5,$PIECE(^DD(40.8,$PIECE(DGJTNODE,"^",2),0),"^",1),?34," Choices: Yes or No",!?10,"If 'YES' the parameter DEFAULT REVIEWING PHYSICIAN will also be asked",!?32," Choices: Primary or Attending Physician"
+3 IF $PIECE(DGJTNODE,"^",3)]""
WRITE !?5,$PIECE(^DD(40.8,$PIECE(DGJTNODE,"^",3),0),"^",1),?32," Choices: Primary or Attending Physician"
+4 IF $PIECE(DGJTNODE,"^",4)]""
WRITE !?5,$PIECE(^DD(40.8,$PIECE(DGJTNODE,"^",4),0),"^",1)," Choices: Primary or Attending Physician"
+5 QUIT
MSG WRITE !!!,"***PLEASE CONTACT YOUR MAS OFFICE IF YOU HAVE ANY QUESTIONS AS TO HOW THE",!,"IRT PARAMETERS SHOULD BE ANSWERED!"
+1 QUIT
