| 1 | DGPTAPA2 ;ALB/MTC - PTF A/P ARCHIVE UTILITY CONT. ; 10-19-92
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | AR401 ;-- this function will load the 401 information
|
|---|
| 5 | N X,X1,Y,I,J,K,OSEQ,SEQ
|
|---|
| 6 | S OSEQ=$G(^DGP(45.62,DGTMP,100,0)) Q:OSEQ']""
|
|---|
| 7 | S SEQ=$P(OSEQ,U,3),REF="^DGP(45.62,"_DGTMP_",100)"
|
|---|
| 8 | ;
|
|---|
| 9 | S (K,I)=0 F S I=$O(^DGPT(DGPTF,"S",I)) Q:'I D
|
|---|
| 10 | . S K=K+1,SEQ=SEQ+1,X=$G(^DGPT(DGPTF,"S",I,0)) Q:X']""
|
|---|
| 11 | .;-- surgery date (4)
|
|---|
| 12 | . S Y=DGPTF_U_"401"_U_K_U_$S($P(X,U):$P(X,U),1:"")
|
|---|
| 13 | .;-- sur specialty (5)
|
|---|
| 14 | . S Y=Y_U_$S($P(X,U,3):$P($G(^DIC(45.3,$P(X,U,3),0)),U,2),1:"")
|
|---|
| 15 | .;-- cat of chief sur (6)
|
|---|
| 16 | . S Y=Y_U_$S($P(X,U,4):$P($P($P(^DD(45.01,4,0),U,3),";",$P(X,U,4)),":",2),$P(X,U,4)="V":"VA TEAM",$P(X,U,4)="M":"MIXED VA&NON VA",$P(X,U,4)="N":"NON VA",1:"")
|
|---|
| 17 | .;-- cat of first ass (7), pric ana (8), source of pay (9)
|
|---|
| 18 | . F J=5,6,7 S Y=Y_U_$S($P(X,U,J):$P($P($P(^DD(45.01,J,0),U,3),";",$P(X,U,J)),":",2),1:"")
|
|---|
| 19 | .;
|
|---|
| 20 | .;-- check for ICD codes (10-14)
|
|---|
| 21 | . F J=8:1:12 D
|
|---|
| 22 | .. S Y=Y_U_$S($P(X,U,J):$P(^ICD0($P(X,U,J),0),U),1:"")
|
|---|
| 23 | .;
|
|---|
| 24 | .;-- check for 300 node information (15)
|
|---|
| 25 | . S X2=$G(^DGPT(DGPTF,"S",I,300))
|
|---|
| 26 | . S Y=Y_U_$S($P(X2,U,2)=1:"Live Donor",$P(X2,U,2)=2:"Cadaver",1:"")
|
|---|
| 27 | . S SEQ=SEQ+1,@REF@(SEQ,0)=Y
|
|---|
| 28 | .;
|
|---|
| 29 | .;-- 401P
|
|---|
| 30 | .;-- ICD codes (4-9)
|
|---|
| 31 | . S X3=$G(^DGPT(DGPTF,"401P")) I X3]"" D S @REF@(SEQ,0)=Y
|
|---|
| 32 | .. S SEQ=SEQ+1,Y=DGPTF_U_"401P"_U_K F J=1:1:5 I $P(X3,U,J) D
|
|---|
| 33 | ... S Y=Y_U_$P(^ICD0($P(X3,U,J),0),U)
|
|---|
| 34 | .;
|
|---|
| 35 | ;
|
|---|
| 36 | ;-- update
|
|---|
| 37 | S $P(^DGP(45.62,DGTMP,100,0),U,3,4)=SEQ_U_SEQ
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | AR601 ;-- this function will load the 601 information
|
|---|
| 41 | N X,Y,I,J,K,OSEQ,SEQ
|
|---|
| 42 | S OSEQ=$G(^DGP(45.62,DGTMP,100,0)) Q:OSEQ']""
|
|---|
| 43 | S SEQ=$P(OSEQ,U,3),REF="^DGP(45.62,"_DGTMP_",100)"
|
|---|
| 44 | ;
|
|---|
| 45 | S (K,I)=0 F S I=$O(^DGPT(DGPTF,"P",I)) Q:'I D
|
|---|
| 46 | . S K=K+1,SEQ=SEQ+1,X=$G(^DGPT(DGPTF,"P",I,0)) Q:X']""
|
|---|
| 47 | .;-- procedure date (4)
|
|---|
| 48 | . S Y=DGPTF_U_"601"_U_K_U_$S($P(X,U):$P(X,U),1:"")
|
|---|
| 49 | .;-- specialty (5)
|
|---|
| 50 | . S Y=Y_U_$P($G(^DIC(42.4,+$P(X,U,2),0)),U,1)
|
|---|
| 51 | .;-- dialysis type (6)
|
|---|
| 52 | . S Y=Y_U_$P($G(^DG(45.4,+$P(X,U,3),0)),U)
|
|---|
| 53 | .;-- # of treat (7)
|
|---|
| 54 | . S Y=Y_U_+$P(X,U,4)
|
|---|
| 55 | .;-- ICD codes (8-12)
|
|---|
| 56 | . F J=5:1:9 D
|
|---|
| 57 | .. S Y=Y_U_$S($P(X,U,J):$P(^ICD0($P(X,U,J),0),U),1:"")
|
|---|
| 58 | . S @REF@(SEQ,0)=Y
|
|---|
| 59 | ;
|
|---|
| 60 | ;-- update
|
|---|
| 61 | S $P(^DGP(45.62,DGTMP,100,0),U,3,4)=SEQ_U_SEQ
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
