- DGPTSUD1 ;ALB/AS/ADL - Look for the same DRG in consecutive RAM movements ; Feb 23 87
- ;;5.3;Registration;**510,478,1015**;Aug 13, 1993;Build 21
- ;;ADL;Update for CSV Project;;Mar 27, 2003
- ;
- ;called from ONE+2^DGPTSUDO
- F I=0:0 S I=$O(^DGPT(PTF,"M",I)) Q:I'>0 I $D(^DGPT(PTF,"M",I,"P")) S DGNODE=^("P"),DGSUDO(+$P(DGNODE,"^",3))=I_"^"_$P(DGNODE,"^",1)
- G Q:'$D(DGSUDO) S (DGSUNX,DGSUPR)=$O(DGSUDO(0)) F XX=0:0 S DGSUNX=$O(DGSUDO(DGSUPR)) Q:DGSUNX'>0 D SAME
- Q K DGSUPR,DGSUNX,DGNODE,DGSUDO,DG1,DG2,DGMV1,DGMV2,DGSUB,DGSUR,DGSURDT,%,I,J,X1,X2 Q
- SAME I $P(DGSUDO(DGSUPR),"^",2)']""!($P(DGSUDO(DGSUPR),"^",2)'=$P(DGSUDO(DGSUNX),"^",2)) S DGSUPR=DGSUNX Q
- S DG1=+$P(DGSUDO(DGSUPR),"^",1),DG2=+$P(DGSUDO(DGSUNX),"^",1),DGMV1=$S($D(^DGPT(PTF,"M",+DG1,"P")):^("P"),1:""),DGMV2=$S($D(^DGPT(PTF,"M",+DG2,"P")):^("P"),1:"")
- ;Fiscal year 89 discharges are checked for a surgery performed while on Surgery Service if the DRG is a surgical DRG
- G 88:'$P($$DRG^ICDGTDRG($P(DGSUDO(DGSUNX),"^",2),$$GETDATE^ICDGTDRG(PTF)),"^",6)
- I $D(^DGPT(PTF,70)),$P(^DGPT(PTF,70),"^",1)<2881000 G 88
- I $P(DGMV1,"^",2)'="S"&($P(DGMV2,"^",2)'="S") G 88
- I $P(DGMV1,"^",2)="S" S I=DGADM F J=0:0 S J=$O(DGSUDO(J)) Q:J=DGSUPR!(J'>0) S I=J
- S X1=$S($P(DGMV1,"^",2)="S":I,1:DGSUPR),X2=$S($P(DGMV1,"^",2)="S":DGSUPR,1:DGSUNX),X1=$P(X1,".",1),X2=$P(X2,".",1)_.99,DGSUR=0
- F I=0:0 S I=$O(^DGPT(PTF,"S",I)) Q:I'>0 S DGSURDT=$S($D(^DGPT(PTF,"S",I,0)):+^(0),1:9999999) I X1<DGSURDT&(DGSURDT<X2) S DGSUR=1 Q
- I DGSUR S DGSUB=$S($P(DGMV1,"^",2)="S":DG1,1:DG2) G KILL
- 88 S DGSUB=$S($P(DGMV1,"^",4)>$P(DGMV2,"^",4):DG1,1:DG2)
- KILL N DGFDA,DGMSG,FLD
- S DGFDA(45.02,DGSUB_","_PTF_",",23)=$P(DGMV1,"^",4)+$P(DGMV2,"^",4)
- D FILE^DIE("","DGFDA","DGMSG")
- I DGSUB=DG1 D Q
- .K DGFDA,DGMSG
- .S DGFDA(45.02,DG1_","_PTF_",",25)=$P(DGMV2,"^",6)
- .D FILE^DIE("","DGFDA","DGMSG")
- .K DGFDA,DGMSG
- .F FLD=20:1:25 S DGFDA(45.02,DG2_","_PTF_",",FLD)="@"
- .D FILE^DIE("","DGFDA","DGMSG")
- .K DGSUDO(DGSUNX)
- K DGFDA,DGMSG
- F FLD=20:1:25 S DGFDA(45.02,DG1_","_PTF_",",FLD)="@"
- D FILE^DIE("","DGFDA","DGMSG")
- K DGSUDO(DGSUPR)
- S DGSUPR=DGSUNX
- Q
- DGPTSUD1 ;ALB/AS/ADL - Look for the same DRG in consecutive RAM movements ; Feb 23 87
- +1 ;;5.3;Registration;**510,478,1015**;Aug 13, 1993;Build 21
- +2 ;;ADL;Update for CSV Project;;Mar 27, 2003
- +3 ;
- +4 ;called from ONE+2^DGPTSUDO
- +5 FOR I=0:0
- SET I=$ORDER(^DGPT(PTF,"M",I))
- IF I'>0
- QUIT
- IF $DATA(^DGPT(PTF,"M",I,"P"))
- SET DGNODE=^("P")
- SET DGSUDO(+$PIECE(DGNODE,"^",3))=I_"^"_$PIECE(DGNODE,"^",1)
- +6 IF '$DATA(DGSUDO)
- GOTO Q
- SET (DGSUNX,DGSUPR)=$ORDER(DGSUDO(0))
- FOR XX=0:0
- SET DGSUNX=$ORDER(DGSUDO(DGSUPR))
- IF DGSUNX'>0
- QUIT
- DO SAME
- Q KILL DGSUPR,DGSUNX,DGNODE,DGSUDO,DG1,DG2,DGMV1,DGMV2,DGSUB,DGSUR,DGSURDT,%,I,J,X1,X2
- QUIT
- SAME IF $PIECE(DGSUDO(DGSUPR),"^",2)']""!($PIECE(DGSUDO(DGSUPR),"^",2)'=$PIECE(DGSUDO(DGSUNX),"^",2))
- SET DGSUPR=DGSUNX
- QUIT
- +1 SET DG1=+$PIECE(DGSUDO(DGSUPR),"^",1)
- SET DG2=+$PIECE(DGSUDO(DGSUNX),"^",1)
- SET DGMV1=$SELECT($DATA(^DGPT(PTF,"M",+DG1,"P")):^("P"),1:"")
- SET DGMV2=$SELECT($DATA(^DGPT(PTF,"M",+DG2,"P")):^("P"),1:"")
- +2 ;Fiscal year 89 discharges are checked for a surgery performed while on Surgery Service if the DRG is a surgical DRG
- +3 IF '$PIECE($$DRG^ICDGTDRG($PIECE(DGSUDO(DGSUNX),"^",2),$$GETDATE^ICDGTDRG(PTF)),"^",6)
- GOTO 88
- +4 IF $DATA(^DGPT(PTF,70))
- IF $PIECE(^DGPT(PTF,70),"^",1)<2881000
- GOTO 88
- +5 IF $PIECE(DGMV1,"^",2)'="S"&($PIECE(DGMV2,"^",2)'="S")
- GOTO 88
- +6 IF $PIECE(DGMV1,"^",2)="S"
- SET I=DGADM
- FOR J=0:0
- SET J=$ORDER(DGSUDO(J))
- IF J=DGSUPR!(J'>0)
- QUIT
- SET I=J
- +7 SET X1=$SELECT($PIECE(DGMV1,"^",2)="S":I,1:DGSUPR)
- SET X2=$SELECT($PIECE(DGMV1,"^",2)="S":DGSUPR,1:DGSUNX)
- SET X1=$PIECE(X1,".",1)
- SET X2=$PIECE(X2,".",1)_.99
- SET DGSUR=0
- +8 FOR I=0:0
- SET I=$ORDER(^DGPT(PTF,"S",I))
- IF I'>0
- QUIT
- SET DGSURDT=$SELECT($DATA(^DGPT(PTF,"S",I,0)):+^(0),1:9999999)
- IF X1<DGSURDT&(DGSURDT<X2)
- SET DGSUR=1
- QUIT
- +9 IF DGSUR
- SET DGSUB=$SELECT($PIECE(DGMV1,"^",2)="S":DG1,1:DG2)
- GOTO KILL
- 88 SET DGSUB=$SELECT($PIECE(DGMV1,"^",4)>$PIECE(DGMV2,"^",4):DG1,1:DG2)
- KILL NEW DGFDA,DGMSG,FLD
- +1 SET DGFDA(45.02,DGSUB_","_PTF_",",23)=$PIECE(DGMV1,"^",4)+$PIECE(DGMV2,"^",4)
- +2 DO FILE^DIE("","DGFDA","DGMSG")
- +3 IF DGSUB=DG1
- Begin DoDot:1
- +4 KILL DGFDA,DGMSG
- +5 SET DGFDA(45.02,DG1_","_PTF_",",25)=$PIECE(DGMV2,"^",6)
- +6 DO FILE^DIE("","DGFDA","DGMSG")
- +7 KILL DGFDA,DGMSG
- +8 FOR FLD=20:1:25
- SET DGFDA(45.02,DG2_","_PTF_",",FLD)="@"
- +9 DO FILE^DIE("","DGFDA","DGMSG")
- +10 KILL DGSUDO(DGSUNX)
- End DoDot:1
- QUIT
- +11 KILL DGFDA,DGMSG
- +12 FOR FLD=20:1:25
- SET DGFDA(45.02,DG1_","_PTF_",",FLD)="@"
- +13 DO FILE^DIE("","DGFDA","DGMSG")
- +14 KILL DGSUDO(DGSUPR)
- +15 SET DGSUPR=DGSUNX
- +16 QUIT
