| [613] | 1 | DGPTAPA3 ;ALB/MTC - PTF A/P ARCHIVE UTILITY CONT. ; 10-19-92
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | AR501 ;-- this function will load the 501 information
|
|---|
| 5 | N X,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,"M",I)) Q:'I D
|
|---|
| 10 | . S K=K+1,SEQ=SEQ+1,X=$G(^DGPT(DGPTF,"M",I,0)) Q:X']""
|
|---|
| 11 | .;-- movement date (4)
|
|---|
| 12 | . S Y=DGPTF_U_"501"_U_K_U_$S($P(X,U,10):$P(X,U,10),1:"")
|
|---|
| 13 | .;-- treated for and SC condition (5)
|
|---|
| 14 | . S Y=Y_U_$S($P(X,U,18)=1:"YES",1:"NO")
|
|---|
| 15 | .;-- leave days (6)
|
|---|
| 16 | . S Y=Y_U_$S($P(X,U,3):$P(X,U,3),1:"")
|
|---|
| 17 | .;-- pass days (7)
|
|---|
| 18 | . S Y=Y_U_$S($P(X,U,4):$P(X,U,4),1:"")
|
|---|
| 19 | .;-- losing specilaty (8)
|
|---|
| 20 | . S Y=Y_U_$S($P(X,U,2):$P(^DIC(42.4,$P(X,U,2),0),U),1:"")
|
|---|
| 21 | .;
|
|---|
| 22 | .;-- check for ICD codes (9-18)
|
|---|
| 23 | . F J=5:1:9,11:1:15 D
|
|---|
| 24 | .. S Y=Y_U_$S($P(X,U,J):$P(^ICD9($P(X,U,J),0),U),1:"")
|
|---|
| 25 | .;
|
|---|
| 26 | .;-- check for 300 node information (19-24)
|
|---|
| 27 | .;
|
|---|
| 28 | . S X2=$G(^DGPT(DGPTF,"M",I,300))
|
|---|
| 29 | . S Y=Y_U_$$AR300^DGPTAPA1(X2)
|
|---|
| 30 | . S SEQ=SEQ+1,@REF@(SEQ,0)=Y
|
|---|
| 31 | ;-- update
|
|---|
| 32 | S $P(^DGP(45.62,DGTMP,100,0),U,3,4)=SEQ_U_SEQ
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | AR535 ;-- this function will load the 535 information
|
|---|
| 36 | N Y,X,I,DG535,OSEQ,SEQ
|
|---|
| 37 | S OSEQ=$G(^DGP(45.62,DGTMP,100,0)) Q:OSEQ']""
|
|---|
| 38 | S SEQ=$P(OSEQ,U,3),REF="^DGP(45.62,"_DGTMP_",100)"
|
|---|
| 39 | ;
|
|---|
| 40 | S (I,DG535)=0 F S DG535=$O(^DGPT(DGPTF,535,DG535)) Q:'DG535 D
|
|---|
| 41 | . S I=I+1,SEQ=SEQ+1,X=$G(^DGPT(DGPTF,535,DG535,0)),X1=""
|
|---|
| 42 | .;-- physical movement # (4)
|
|---|
| 43 | . S Y=DGPTF_U_"535"_U_I_U_$S($P(X,U,10):$P(X,U,10),1:"")
|
|---|
| 44 | .;-- losing specialty (5)
|
|---|
| 45 | . S Y=Y_U_$P(^DIC(42.4,$P(X,U,2),0),U,1)
|
|---|
| 46 | .;-- leave days (6)
|
|---|
| 47 | . S Y=Y_U_$P(X,U,3)
|
|---|
| 48 | .;-- pass days (7)
|
|---|
| 49 | . S Y=Y_U_$P(X,U,4)
|
|---|
| 50 | .; losing ward (8)
|
|---|
| 51 | . S Y=Y_U_$P(^DIC(42,$P(X,U,6),0),U)
|
|---|
| 52 | . S @REF@(SEQ,0)=Y
|
|---|
| 53 | ;-- update
|
|---|
| 54 | S $P(^DGP(45.62,DGTMP,100,0),U,3,4)=SEQ_U_SEQ
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
