- DG1010S1 ;ALB/MRL - SUPPLEMENTAL DATA SHEET FOR 10-10 ; 19 JUN 86
- ;;5.3;Registration;;Aug 13, 1993
- ;;MAS VERSION 5.1;
- ;
- ;INPUT: DFN = IEN OF PATIENT FILE
- ; DFN1 = INVERSE DISPOSTION TIME
- EN ;
- S DGLDOUBL="",$P(DGLDOUBL,"=",132)=""
- S DGLSUP="",$P(DGLSUP,"- ",62)="",$P(DGLSUP,"- ",43)=" |"
- S DGLSUP1="",$P(DGLSUP1,"-",123)="",$P(DGLSUP1,"-",86)="|"
- F I="INE","DIS",0,.15,.24,.361 S DGP(I)=$G(^DPT(DFN,I))
- S DGD=$G(^DPT(DFN,"DIS",DFN1,0)),Y=$P(DGD,U,1) X ^DD("DD") S DGAP=Y,DGCLK=$S($D(^VA(200,+$P(DGD,U,5),0)):$S($P(^(0),U,2)]"":$P(^(0),U,2)_"/"_$P(DGD,U,5),1:"unk/"_$P(DGD,U,5)),1:"unspecified"),DGNAM=$P(DGP(0),U,1)
- S DGSS=$P(DGP(0),U,9),DGSS=$E(DGSS,1,3)_"-"_$E(DGSS,4,5)_"-"_$E(DGSS,6,10)
- S DGLDOUBL=$E(DGLDOUBL,1,127)
- I $$FIRST^DGUTL G Q^DG1010S2
- W !?5,DGLDOUBL,!?5
- S X=$$SITE^VASITE W $S((+X=-1):"FACILITY NOT IDENTIFIED",1:$P(X,U,2)_" ("_$P(X,U,3)_")")
- W ?105,"SUPPLEMENTAL DATA SHEET",!?5,DGLDOUBL,!?5,"1. Applicant's Name: ",DGNAM,?90,"| 2. SSN: ",DGSS,!?5,DGLSUP1,!?5,"3. Other Name(s): "
- S I1="" F I=0:0 S I=$O(^DPT(DFN,.01,I)) Q:I'>0 S I1=1,DGD=$P(^(I,0),U,1),DGD(1)=$P(^(0),U,2),DGD=DGD_$S($L(DGD(1)):" ("_$E(DGD(1),1,3)_"-"_$E(DGD(1),4,5)_"-"_$E(DGD(1),6,10)_")",1:"")_"; " W:(128-$X)<$L(DGD) !?9 W DGD
- W:'I1 "NO ALIAS' ON FILE" K DGD,I,I1 S DGD=$S($L($P(DGP(0),U,10)):$P(DGP(0),U,10),1:"NO REMARKS CURRENTLY ENTERED FOR THIS APPLICANT") W !?5,DGLSUP1,!?5,"4. Remarks: ",DGD,!?5,DGLSUP1
- S DGD=DGP(.24) W !?5,"5. Fathers Name: ",$S($L($P(DGD,U,1)):$P(DGD,U,1),1:"NOT SPECIFIED"),?90,"|"
- W !?9,"Mothers Name: ",$S($L($P(DGD,U,2)):$P(DGD,U,2),1:"NOT SPECIFIED"),?90,"|",!?9,"Mothers Maiden Name: ",$S($L($P(DGD,U,3)):$P(DGD,U,3),1:"NOT SPECIFIED"),?90,"|",!?5,DGLSUP1
- W !?5,"6a. Enrollment Clinic(s): " S I1="" F I=0:0 S I=$O(^DPT(DFN,"DE",I)) Q:I'>0 I $P(^(I,0),U,2)'="I" S I1=I1+1,DGD=$S($D(^SC(+^(0),0)):$P(^(0),U,1)_", ",1:"") W:(128-$X)<$L(DGD) !?9 W DGD
- W:'I1 "NOT ACTIVELY ENROLLED IN ANY CLINICS AT THIS TIME" K DGD,I,I1 W !?5,DGLSUP,!?5,"6b. Future Appointments: " S I1="",I2=DT_".9999"
- F J=0:0 S I2=$O(^DPT(DFN,"S",I2)) Q:I2="" I $S($P(^(I2,0),U,2)']"":1,$P(^(0),U,2)="I":1,1:0) S DGD(1)=+$P(^(0),U,1),Y=I2 X ^DD("DD") S DGD=$S($D(^SC(+DGD(1),0)):$P(^(0),U,1),1:"UNKNOWN")_" ("_Y_"), ",I1=1 W:(128-$X)<$L(DGD) !?9 W DGD
- W:'I1 "NO PENDING APPOINTMENTS ON FILE" W !?5,DGLSUP1,!?5,"7a. Last Admission: "
- S DGAD=$S('$D(^DPT(DFN,.1)):0,'$L(^DPT(DFN,.1)):0,1:1),DGD=$O(^DGPM("ATID1",DFN,+$S(DGAD:$O(^DGPM("ATID1",DFN,0)),1:0))) I DGD'>0 W "NO PREVIOUS ADMISSIONS TO THIS FACILITY ON FILE" G EL
- S DGD=$O(^DGPM("ATID1",DFN,DGD,0)) I $S('$D(^DGPM(+DGD,0)):1,'$D(^DGPT(+$P(^(0),"^",16),0)):1,1:0) W "LAST ADMISSION PTF DATA NO LONGER STORED" G EL
- S DGD=+$P(^DGPM(+DGD,0),"^",16),Y=+^(0)
- X ^DD("DD") W Y S Y=$P($S($D(^DGPT(DGD,70)):^(70),1:0),U,1) X ^DD("DD") W:Y]"" " (DISCHARGED '"_Y_"')" W !?5,DGLSUP,!?5,"7b. Discharge Diagnosis(es): " S I1=$S($D(^DGPT(DGD,"M",1,0)):^(0),1:0)
- S I3="" F I=5:1:15 I I'=10 S I2=$P(I1,U,I) Q:'I2 S I3=1,I2=$S($D(^ICD9(I2,0)):"("_$P(^(0),U,1)_")-"_$P(^(0),U,3)_"; ",1:"") W:(128-$X)<$L(I2) !?9 W I2
- W:'I3 "NO DIAGNOSES ON FILE FOR THIS ADMISSION PERIOD YET",!?5,DGLSUP S DGD(1)=$S($D(^DGPT(DGD,70)):^(70),1:0),X="UNSPECIFIED",X=$S('DGD(1):X,$D(^ICD9(+$P(DGD(1),U,11),0)):"("_$P(^(0),U,1)_")-"_$P(^(0),U,3),1:X)
- W !?5,"7c. Admit Diagnosis: ",X,!?5,DGLSUP,!?5,"7d. Diagnosis Responsible for Greatest Length of Stay: " S X="UNSPECIFIED",X=$S('DGD(1):X,$D(^ICD9(+$P(DGD(1),U,10),0)):"("_$P(^(0),U,1)_")-"_$P(^(0),U,3),1:X) W X
- EL W !?5,DGLSUP1 S DGD=DGP(.361),DGD(1)=$P(DGD,U,5),DGD(2)=$P(DGD,U,6),Y=$P(DGD,U,2),DGD=$P(DGD,U,1),DGD(1)=$S($L(DGD(1)):DGD(1),'$L(DGD):"NOT APPLICABLE",1:"NOT VERIFIED")
- S DGD(2)=$S(+DGD(2):$S($D(^VA(200,+DGD(2),0)):$P(^(0),U,1),1:"UNKNOWN"),'$L(DGD):"NOT APPLICABLE",1:"NOT SPECIFIED") X:+Y ^DD("DD") S Y=$S($L(Y):Y,'$L(DGD):"NOT APPLICABLE",1:"NOT SPECIFIED")
- W !?5,"8. Eligibility Status: ",$S(DGD="P":"PENDING VERIFICATION",DGD="R":"PENDING RE-VERIFICATION",DGD="V":"VERIFIED",1:"UNKNOWN OR NONE"),?90,"| Status Date: ",Y,!?9,"Verification Method: ",DGD(1),?90,"| By: ",DGD(2)
- S Y=$P(DGP(.15),U,2),DGD=DGP("INE") X:+Y ^DD("DD") S DGEL=$S('$L(Y)!(Y=0):1,1:0),Y=$S('DGEL:Y,1:"ELIGIBLE APPLICANT -- NOT APPLICABLE") W !?9,"Ineligible Date: ",Y I DGEL F I=1:1:4 S DGD(I)="NOT APPLICABLE"
- G:DGEL C S DGD(1)=$P(DGD,U,1),DGD(1)=$S(DGD(1)=1:"VAMC",DGD(1)=2:"REGIONAL OFFICE",DGD(2)=3:"RPC",1:"UNKNOWN"),DGD(2)=$S($L($P(DGD,U,3)):$P(DGD,U,3),1:"CITY UNKNOWN"),DGD(3)=$S($D(^DIC(5,+$P(DGD,U,4),0)):$P(^(0),U,1),1:"STATE UNKNOWN")
- S DGD(4)=$S($P(DGD,U,6)]"":$P(DGD,U,6),1:"VARO DECISION UNKNOWN")
- C W ?90,"| TWX Source: ",DGD(1),!?9,"TWX City: ",DGD(2),?90,"| TWX State: ",$E(DGD(3),1,26),!?9,"VARO Decision: ",DGD(4),!?5,DGLSUP1
- K DGAD,DGD,DGEL,I,I1,I2,Y G ^DG1010S2
- DG1010S1 ;ALB/MRL - SUPPLEMENTAL DATA SHEET FOR 10-10 ; 19 JUN 86
- +1 ;;5.3;Registration;;Aug 13, 1993
- +2 ;;MAS VERSION 5.1;
- +3 ;
- +4 ;INPUT: DFN = IEN OF PATIENT FILE
- +5 ; DFN1 = INVERSE DISPOSTION TIME
- EN ;
- +1 SET DGLDOUBL=""
- SET $PIECE(DGLDOUBL,"=",132)=""
- +2 SET DGLSUP=""
- SET $PIECE(DGLSUP,"- ",62)=""
- SET $PIECE(DGLSUP,"- ",43)=" |"
- +3 SET DGLSUP1=""
- SET $PIECE(DGLSUP1,"-",123)=""
- SET $PIECE(DGLSUP1,"-",86)="|"
- +4 FOR I="INE","DIS",0,.15,.24,.361
- SET DGP(I)=$GET(^DPT(DFN,I))
- +5 SET DGD=$GET(^DPT(DFN,"DIS",DFN1,0))
- SET Y=$PIECE(DGD,U,1)
- XECUTE ^DD("DD")
- SET DGAP=Y
- SET DGCLK=$SELECT($DATA(^VA(200,+$PIECE(DGD,U,5),0)):$SELECT($PIECE(^(0),U,2)]"":$PIECE(^(0),U,2)_"/"_$PIECE(DGD,U,5),1:"unk/"_$PIECE(DGD,U,5)),1:"unspecified")
- SET DGNAM=$PIECE(DGP(0),U,1)
- +6 SET DGSS=$PIECE(DGP(0),U,9)
- SET DGSS=$EXTRACT(DGSS,1,3)_"-"_$EXTRACT(DGSS,4,5)_"-"_$EXTRACT(DGSS,6,10)
- +7 SET DGLDOUBL=$EXTRACT(DGLDOUBL,1,127)
- +8 IF $$FIRST^DGUTL
- GOTO Q^DG1010S2
- +9 WRITE !?5,DGLDOUBL,!?5
- +10 SET X=$$SITE^VASITE
- WRITE $SELECT((+X=-1):"FACILITY NOT IDENTIFIED",1:$PIECE(X,U,2)_" ("_$PIECE(X,U,3)_")")
- +11 WRITE ?105,"SUPPLEMENTAL DATA SHEET",!?5,DGLDOUBL,!?5,"1. Applicant's Name: ",DGNAM,?90,"| 2. SSN: ",DGSS,!?5,DGLSUP1,!?5,"3. Other Name(s): "
- +12 SET I1=""
- FOR I=0:0
- SET I=$ORDER(^DPT(DFN,.01,I))
- IF I'>0
- QUIT
- SET I1=1
- SET DGD=$PIECE(^(I,0),U,1)
- SET DGD(1)=$PIECE(^(0),U,2)
- SET DGD=DGD_$SELECT($LENGTH(DGD(1)):" ("_$EXTRACT(DGD(1),1,3)_"-"_$EXTRACT(DGD(1),4,5)_"-"_$EXTRACT(DGD(1),6,10)_")",1:"")_"; "
- IF (128-$X)<$LENGTH(DGD)
- WRITE !?9
- WRITE DGD
- +13 IF 'I1
- WRITE "NO ALIAS' ON FILE"
- KILL DGD,I,I1
- SET DGD=$SELECT($LENGTH($PIECE(DGP(0),U,10)):$PIECE(DGP(0),U,10),1:"NO REMARKS CURRENTLY ENTERED FOR THIS APPLICANT")
- WRITE !?5,DGLSUP1,!?5,"4. Remarks: ",DGD,!?5,DGLSUP1
- +14 SET DGD=DGP(.24)
- WRITE !?5,"5. Fathers Name: ",$SELECT($LENGTH($PIECE(DGD,U,1)):$PIECE(DGD,U,1),1:"NOT SPECIFIED"),?90,"|"
- +15 WRITE !?9,"Mothers Name: ",$SELECT($LENGTH($PIECE(DGD,U,2)):$PIECE(DGD,U,2),1:"NOT SPECIFIED"),?90,"|",!?9,"Mothers Maiden Name: ",$SELECT($LENGTH($PIECE(DGD,U,3)):$PIECE(DGD,U,3),1:"NOT SPECIFIED"),?90,"|",!?5,DGLSUP1
- +16 WRITE !?5,"6a. Enrollment Clinic(s): "
- SET I1=""
- FOR I=0:0
- SET I=$ORDER(^DPT(DFN,"DE",I))
- IF I'>0
- QUIT
- IF $PIECE(^(I,0),U,2)'="I"
- SET I1=I1+1
- SET DGD=$SELECT($DATA(^SC(+^(0),0)):$PIECE(^(0),U,1)_", ",1:"")
- IF (128-$X)<$LENGTH(DGD)
- WRITE !?9
- WRITE DGD
- +17 IF 'I1
- WRITE "NOT ACTIVELY ENROLLED IN ANY CLINICS AT THIS TIME"
- KILL DGD,I,I1
- WRITE !?5,DGLSUP,!?5,"6b. Future Appointments: "
- SET I1=""
- SET I2=DT_".9999"
- +18 FOR J=0:0
- SET I2=$ORDER(^DPT(DFN,"S",I2))
- IF I2=""
- QUIT
- IF $SELECT($PIECE(^(I2,0),U,2)']"":1,$PIECE(^(0),U,2)="I":1,1:0)
- SET DGD(1)=+$PIECE(^(0),U,1)
- SET Y=I2
- XECUTE ^DD("DD")
- SET DGD=$SELECT($DATA(^SC(+DGD(1),0)):$PIECE(^(0),U,1),1:"UNKNOWN")_" ("_Y_"), "
- SET I1=1
- IF (128-$X)<$LENGTH(DGD)
- WRITE !?9
- WRITE DGD
- +19 IF 'I1
- WRITE "NO PENDING APPOINTMENTS ON FILE"
- WRITE !?5,DGLSUP1,!?5,"7a. Last Admission: "
- +20 SET DGAD=$SELECT('$DATA(^DPT(DFN,.1)):0,'$LENGTH(^DPT(DFN,.1)):0,1:1)
- SET DGD=$ORDER(^DGPM("ATID1",DFN,+$SELECT(DGAD:$ORDER(^DGPM("ATID1",DFN,0)),1:0)))
- IF DGD'>0
- WRITE "NO PREVIOUS ADMISSIONS TO THIS FACILITY ON FILE"
- GOTO EL
- +21 SET DGD=$ORDER(^DGPM("ATID1",DFN,DGD,0))
- IF $SELECT('$DATA(^DGPM(+DGD,0)):1,'$DATA(^DGPT(+$PIECE(^(0),"^",16),0)):1,1:0)
- WRITE "LAST ADMISSION PTF DATA NO LONGER STORED"
- GOTO EL
- +22 SET DGD=+$PIECE(^DGPM(+DGD,0),"^",16)
- SET Y=+^(0)
- +23 XECUTE ^DD("DD")
- WRITE Y
- SET Y=$PIECE($SELECT($DATA(^DGPT(DGD,70)):^(70),1:0),U,1)
- XECUTE ^DD("DD")
- IF Y]""
- WRITE " (DISCHARGED '"_Y_"')"
- WRITE !?5,DGLSUP,!?5,"7b. Discharge Diagnosis(es): "
- SET I1=$SELECT($DATA(^DGPT(DGD,"M",1,0)):^(0),1:0)
- +24 SET I3=""
- FOR I=5:1:15
- IF I'=10
- SET I2=$PIECE(I1,U,I)
- IF 'I2
- QUIT
- SET I3=1
- SET I2=$SELECT($DATA(^ICD9(I2,0)):"("_$PIECE(^(0),U,1)_")-"_$PIECE(^(0),U,3)_"; ",1:"")
- IF (128-$X)<$LENGTH(I2)
- WRITE !?9
- WRITE I2
- +25 IF 'I3
- WRITE "NO DIAGNOSES ON FILE FOR THIS ADMISSION PERIOD YET",!?5,DGLSUP
- SET DGD(1)=$SELECT($DATA(^DGPT(DGD,70)):^(70),1:0)
- SET X="UNSPECIFIED"
- SET X=$SELECT('DGD(1):X,$DATA(^ICD9(+$PIECE(DGD(1),U,11),0)):"("_$PIECE(^(0),U,1)_")-"_$PIECE(^(0),U,3),1:X)
- +26 WRITE !?5,"7c. Admit Diagnosis: ",X,!?5,DGLSUP,!?5,"7d. Diagnosis Responsible for Greatest Length of Stay: "
- SET X="UNSPECIFIED"
- SET X=$SELECT('DGD(1):X,$DATA(^ICD9(+$PIECE(DGD(1),U,10),0)):"("_$PIECE(^(0),U,1)_")-"_$PIECE(^(0),U,3),1:X)
- WRITE X
- EL WRITE !?5,DGLSUP1
- SET DGD=DGP(.361)
- SET DGD(1)=$PIECE(DGD,U,5)
- SET DGD(2)=$PIECE(DGD,U,6)
- SET Y=$PIECE(DGD,U,2)
- SET DGD=$PIECE(DGD,U,1)
- SET DGD(1)=$SELECT($LENGTH(DGD(1)):DGD(1),'$LENGTH(DGD):"NOT APPLICABLE",1:"NOT VERIFIED")
- +1 SET DGD(2)=$SELECT(+DGD(2):$SELECT($DATA(^VA(200,+DGD(2),0)):$PIECE(^(0),U,1),1:"UNKNOWN"),'$LENGTH(DGD):"NOT APPLICABLE",1:"NOT SPECIFIED")
- IF +Y
- XECUTE ^DD("DD")
- SET Y=$SELECT($LENGTH(Y):Y,'$LENGTH(DGD):"NOT APPLICABLE",1:"NOT SPECIFIED")
- +2 WRITE !?5,"8. Eligibility Status: ",$SELECT(DGD="P":"PENDING VERIFICATION",DGD="R":"PENDING RE-VERIFICATION",DGD="V":"VERIFIED",1:"UNKNOWN OR NONE"),?90,"| Status Date: ",Y,!?9,"Verification Method: ",DGD(1),?90,"| By: ",DGD(2)
- +3 SET Y=$PIECE(DGP(.15),U,2)
- SET DGD=DGP("INE")
- IF +Y
- XECUTE ^DD("DD")
- SET DGEL=$SELECT('$LENGTH(Y)!(Y=0):1,1:0)
- SET Y=$SELECT('DGEL:Y,1:"ELIGIBLE APPLICANT -- NOT APPLICABLE")
- WRITE !?9,"Ineligible Date: ",Y
- IF DGEL
- FOR I=1:1:4
- SET DGD(I)="NOT APPLICABLE"
- +4 IF DGEL
- GOTO C
- SET DGD(1)=$PIECE(DGD,U,1)
- SET DGD(1)=$SELECT(DGD(1)=1:"VAMC",DGD(1)=2:"REGIONAL OFFICE",DGD(2)=3:"RPC",1:"UNKNOWN")
- SET DGD(2)=$SELECT($LENGTH($PIECE(DGD,U,3)):$PIECE(DGD,U,3),1:"CITY UNKNOWN")
- SET DGD(3)=$SELECT($DATA(^DIC(5,+$PIECE(DGD,U,4),0)):$PIECE(^(0),U,1),1:"STATE UNKNOWN")
- +5 SET DGD(4)=$SELECT($PIECE(DGD,U,6)]"":$PIECE(DGD,U,6),1:"VARO DECISION UNKNOWN")
- C WRITE ?90,"| TWX Source: ",DGD(1),!?9,"TWX City: ",DGD(2),?90,"| TWX State: ",$EXTRACT(DGD(3),1,26),!?9,"VARO Decision: ",DGD(4),!?5,DGLSUP1
- +1 KILL DGAD,DGD,DGEL,I,I1,I2,Y
- GOTO ^DG1010S2
