- 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
