- SDPPDIS1 ;ALB/CAW - Patient Profile - Disposition ; 5/3/92
- ;;5.3;Scheduling;**6**;Aug 13, 1993
- ;
- ;
- EN1 ;
- N SDBEN,SDBENE,SDCAR,SDCARE,SDDIS,SDSC,SDSTAT,SDSTATUS,SDVER,SDYN,SDSTART,SDSTOP
- S SDSTART=$S($D(SDBEG):9999999,1:9999999-SDBD),SDSTOP=$S($D(SDEND):0,1:9999999-SDED),SDFST=20,SDSEC=60,SDLEN=20
- I SDSTOP'=0 S SDSTOP=SDSTOP-1
- F SD=SDSTOP:0 S SD=$O(^DPT(DFN,"DIS",SD)) Q:'SD!(SD>(SDSTART+.9)) S SDDIS(0)=$G(^(SD,0)),SDDIS(2)=$G(^(2)),SDDIS(3)=$G(^(3)) D INFO
- Q
- INFO ; Set up info for display
- ;
- LOGIN ; Log In Date/Time and Log Out Date/Time
- S X="",X=$$SETSTR^VALM1("Log In Date/Time:",X,2,17)
- S X=$$SETSTR^VALM1($$FDTTM^VALM1(+SDDIS(0)),X,SDFST,SDLEN)
- S X=$$SETSTR^VALM1("Log Out Date/Time:",X,41,18)
- S X=$$SETSTR^VALM1($$FDTTM^VALM1($P(SDDIS(0),U,6)),X,SDSEC,SDLEN)
- D SET(X)
- BENE ; Type of Benefit Applied For and Disposition
- S X="",X=$$SETSTR^VALM1("Benefit Appl. For:",X,1,18)
- S SDBEN=$P(SDDIS(0),U,3),SDBENE=$S(SDBEN=1:"HOSPITAL",SDBEN=2:"DOMICILIARY",SDBEN=3:"OUTPATIENT MEDICAL",SDBEN=4:"OUTPATIENT DENTAL",SDBEN=5:"NURSING HOME CARE",1:"UNKNOWN")
- S X=$$SETSTR^VALM1(SDBENE,X,SDFST,SDLEN)
- S X=$$SETSTR^VALM1("Disposition:",X,47,12)
- S X=$$SETSTR^VALM1($P($G(^DIC(37,+$P(SDDIS(0),U,7),0)),U),X,SDSEC,SDLEN)
- D SET(X)
- CARE ; Type of Care Applied For and Status
- S X="",X=$$SETSTR^VALM1("Care Applied For:",X,2,17)
- S SDCAR=$P(SDDIS(0),U,11),SDCARE=$S(SDCAR=1:"DENTAL",SDCAR=2:"PLASTIC SURGERY",SDCAR=3:"STERILIZATION",SDCAR=4:"PREGNANCY",SDCAR=5:"ALL OTHER",1:"UNKNOWN")
- S X=$$SETSTR^VALM1(SDCARE,X,SDFST,SDLEN)
- S X=$$SETSTR^VALM1("Status:",X,52,7)
- S SDSTAT=$P(SDDIS(0),U,2),SDSTATUS=$S(SDSTAT=0:"10/10 VISIT",SDSTAT=1:"UNSCHEDULED",SDSTAT=2:"APPLICATION W/O EXAM",1:"UNKNOWN")
- S X=$$SETSTR^VALM1(SDSTATUS,X,SDSEC,SDLEN)
- D SET(X)
- FAC ; Facility Applying To and Amis 400 Series
- S X="",X=$$SETSTR^VALM1("Fac. Applying To:",X,2,17)
- S X=$$SETSTR^VALM1($P($G(^DG(40.8,+$P(SDDIS(0),U,4),0)),U),X,SDFST,SDLEN)
- S X=$$SETSTR^VALM1("AMIS 420 Series:",X,43,16)
- S X=$$SETSTR^VALM1($P(SDDIS(0),U,17),X,SDSEC,SDLEN)
- D SET(X)
- REG ; Registration Eligiblity Code and Eligibility Verified at Registration
- S X="",X=$$SETSTR^VALM1("Reg. Elig. Code:",X,3,16)
- S X=$$SETSTR^VALM1($P($G(^DIC(8,+$P(SDDIS(0),U,13),0)),U),X,SDFST,SDLEN)
- S X=$$SETSTR^VALM1("Elig Ver. at Reg.:",X,41,18)
- S SDVER=$S($P(SDDIS(0),U,14)=0:"NO",$P(SDDIS(0),U,14)=1:"YES",1:"UNKNOWN")
- S X=$$SETSTR^VALM1(SDVER,X,SDSEC,SDLEN)
- D SET(X)
- WHOE ; Who entered 10/10 and SC at Registration
- S X="",X=$$SETSTR^VALM1("Who entered 10/10:",X,1,18)
- S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDDIS(0),U,5),0)),U),X,SDFST,SDLEN)
- S X=$$SETSTR^VALM1("SC at Reg.:",X,48,11)
- S SDSC=$S($P(SDDIS(0),U,15)=0:"NO",$P(SDDIS(0),U,15)=1:"YES",1:"UNKNOWN")
- S X=$$SETSTR^VALM1(SDSC,X,SDSEC,SDLEN)
- D SET(X)
- WHOD ; Who dispositioned and SC % At Registration
- S X="",X=$$SETSTR^VALM1("Who Dispositioned:",X,1,18)
- S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDDIS(0),U,9),0)),U),X,SDFST,SDLEN)
- I $P(SDDIS(0),U,16)'="" D
- .S X=$$SETSTR^VALM1("SC % At Reg.:",X,46,13)
- .S X=$$SETSTR^VALM1($P(SDDIS(0),U,16)_"%",X,SDSEC,SDLEN)
- D SET(X)
- ACTIVE ; Active (registration has not been dispositioned) and Reason Late Disp
- S X=""
- I $P(SDDIS(0),U,10)'="" D
- .S X=$$SETSTR^VALM1("Active:",X,12,7)
- .S X=$$SETSTR^VALM1("YES",X,SDFST,SDLEN)
- I $P(SDDIS(0),U,8)'="" D
- .S X=$$SETSTR^VALM1("Reason Late Disp.:",X,41,18)
- .S X=$$SETSTR^VALM1($P($G(^DIC(30,$P(SDDIS(0),U,8),0)),U),X,SDSEC,SDLEN)
- D:X'="" SET(X)
- D ^SDPPDIS2 Q
- SET(X) ; Set in ^TMP global for display
- ;
- S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPPDIS1 3627 printed Feb 19, 2025@00:26:14 Page 2
- SDPPDIS1 ;ALB/CAW - Patient Profile - Disposition ; 5/3/92
- +1 ;;5.3;Scheduling;**6**;Aug 13, 1993
- +2 ;
- +3 ;
- EN1 ;
- +1 NEW SDBEN,SDBENE,SDCAR,SDCARE,SDDIS,SDSC,SDSTAT,SDSTATUS,SDVER,SDYN,SDSTART,SDSTOP
- +2 SET SDSTART=$SELECT($DATA(SDBEG):9999999,1:9999999-SDBD)
- SET SDSTOP=$SELECT($DATA(SDEND):0,1:9999999-SDED)
- SET SDFST=20
- SET SDSEC=60
- SET SDLEN=20
- +3 IF SDSTOP'=0
- SET SDSTOP=SDSTOP-1
- +4 FOR SD=SDSTOP:0
- SET SD=$ORDER(^DPT(DFN,"DIS",SD))
- if 'SD!(SD>(SDSTART+.9))
- QUIT
- SET SDDIS(0)=$GET(^(SD,0))
- SET SDDIS(2)=$GET(^(2))
- SET SDDIS(3)=$GET(^(3))
- DO INFO
- +5 QUIT
- INFO ; Set up info for display
- +1 ;
- LOGIN ; Log In Date/Time and Log Out Date/Time
- +1 SET X=""
- SET X=$$SETSTR^VALM1("Log In Date/Time:",X,2,17)
- +2 SET X=$$SETSTR^VALM1($$FDTTM^VALM1(+SDDIS(0)),X,SDFST,SDLEN)
- +3 SET X=$$SETSTR^VALM1("Log Out Date/Time:",X,41,18)
- +4 SET X=$$SETSTR^VALM1($$FDTTM^VALM1($PIECE(SDDIS(0),U,6)),X,SDSEC,SDLEN)
- +5 DO SET(X)
- BENE ; Type of Benefit Applied For and Disposition
- +1 SET X=""
- SET X=$$SETSTR^VALM1("Benefit Appl. For:",X,1,18)
- +2 SET SDBEN=$PIECE(SDDIS(0),U,3)
- SET SDBENE=$SELECT(SDBEN=1:"HOSPITAL",SDBEN=2:"DOMICILIARY",SDBEN=3:"OUTPATIENT MEDICAL",SDBEN=4:"OUTPATIENT DENTAL",SDBEN=5:"NURSING HOME CARE",1:"UNKNOWN")
- +3 SET X=$$SETSTR^VALM1(SDBENE,X,SDFST,SDLEN)
- +4 SET X=$$SETSTR^VALM1("Disposition:",X,47,12)
- +5 SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(37,+$PIECE(SDDIS(0),U,7),0)),U),X,SDSEC,SDLEN)
- +6 DO SET(X)
- CARE ; Type of Care Applied For and Status
- +1 SET X=""
- SET X=$$SETSTR^VALM1("Care Applied For:",X,2,17)
- +2 SET SDCAR=$PIECE(SDDIS(0),U,11)
- SET SDCARE=$SELECT(SDCAR=1:"DENTAL",SDCAR=2:"PLASTIC SURGERY",SDCAR=3:"STERILIZATION",SDCAR=4:"PREGNANCY",SDCAR=5:"ALL OTHER",1:"UNKNOWN")
- +3 SET X=$$SETSTR^VALM1(SDCARE,X,SDFST,SDLEN)
- +4 SET X=$$SETSTR^VALM1("Status:",X,52,7)
- +5 SET SDSTAT=$PIECE(SDDIS(0),U,2)
- SET SDSTATUS=$SELECT(SDSTAT=0:"10/10 VISIT",SDSTAT=1:"UNSCHEDULED",SDSTAT=2:"APPLICATION W/O EXAM",1:"UNKNOWN")
- +6 SET X=$$SETSTR^VALM1(SDSTATUS,X,SDSEC,SDLEN)
- +7 DO SET(X)
- FAC ; Facility Applying To and Amis 400 Series
- +1 SET X=""
- SET X=$$SETSTR^VALM1("Fac. Applying To:",X,2,17)
- +2 SET X=$$SETSTR^VALM1($PIECE($GET(^DG(40.8,+$PIECE(SDDIS(0),U,4),0)),U),X,SDFST,SDLEN)
- +3 SET X=$$SETSTR^VALM1("AMIS 420 Series:",X,43,16)
- +4 SET X=$$SETSTR^VALM1($PIECE(SDDIS(0),U,17),X,SDSEC,SDLEN)
- +5 DO SET(X)
- REG ; Registration Eligiblity Code and Eligibility Verified at Registration
- +1 SET X=""
- SET X=$$SETSTR^VALM1("Reg. Elig. Code:",X,3,16)
- +2 SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(8,+$PIECE(SDDIS(0),U,13),0)),U),X,SDFST,SDLEN)
- +3 SET X=$$SETSTR^VALM1("Elig Ver. at Reg.:",X,41,18)
- +4 SET SDVER=$SELECT($PIECE(SDDIS(0),U,14)=0:"NO",$PIECE(SDDIS(0),U,14)=1:"YES",1:"UNKNOWN")
- +5 SET X=$$SETSTR^VALM1(SDVER,X,SDSEC,SDLEN)
- +6 DO SET(X)
- WHOE ; Who entered 10/10 and SC at Registration
- +1 SET X=""
- SET X=$$SETSTR^VALM1("Who entered 10/10:",X,1,18)
- +2 SET X=$$SETSTR^VALM1($PIECE($GET(^VA(200,+$PIECE(SDDIS(0),U,5),0)),U),X,SDFST,SDLEN)
- +3 SET X=$$SETSTR^VALM1("SC at Reg.:",X,48,11)
- +4 SET SDSC=$SELECT($PIECE(SDDIS(0),U,15)=0:"NO",$PIECE(SDDIS(0),U,15)=1:"YES",1:"UNKNOWN")
- +5 SET X=$$SETSTR^VALM1(SDSC,X,SDSEC,SDLEN)
- +6 DO SET(X)
- WHOD ; Who dispositioned and SC % At Registration
- +1 SET X=""
- SET X=$$SETSTR^VALM1("Who Dispositioned:",X,1,18)
- +2 SET X=$$SETSTR^VALM1($PIECE($GET(^VA(200,+$PIECE(SDDIS(0),U,9),0)),U),X,SDFST,SDLEN)
- +3 IF $PIECE(SDDIS(0),U,16)'=""
- Begin DoDot:1
- +4 SET X=$$SETSTR^VALM1("SC % At Reg.:",X,46,13)
- +5 SET X=$$SETSTR^VALM1($PIECE(SDDIS(0),U,16)_"%",X,SDSEC,SDLEN)
- End DoDot:1
- +6 DO SET(X)
- ACTIVE ; Active (registration has not been dispositioned) and Reason Late Disp
- +1 SET X=""
- +2 IF $PIECE(SDDIS(0),U,10)'=""
- Begin DoDot:1
- +3 SET X=$$SETSTR^VALM1("Active:",X,12,7)
- +4 SET X=$$SETSTR^VALM1("YES",X,SDFST,SDLEN)
- End DoDot:1
- +5 IF $PIECE(SDDIS(0),U,8)'=""
- Begin DoDot:1
- +6 SET X=$$SETSTR^VALM1("Reason Late Disp.:",X,41,18)
- +7 SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(30,$PIECE(SDDIS(0),U,8),0)),U),X,SDSEC,SDLEN)
- End DoDot:1
- +8 if X'=""
- DO SET(X)
- +9 DO ^SDPPDIS2
- QUIT
- SET(X) ; Set in ^TMP global for display
- +1 ;
- +2 SET SDLN=SDLN+1
- SET ^TMP("SDPPALL",$JOB,SDLN,0)=X
- +3 QUIT