DGPMTSI1.m

DGPMTSI1 ;ALB/LM - TREATING SPECIALTY INPATIENT SET ; 3/10/93

 ;;5.3;Registration;;Aug 13, 1993

 ;

 Q

START S DIV=$S($P(^DIC(42,+DGW,0),"^",11)]"":$P(^DIC(42,+DGW,0),"^",11),1:0)

 S DIV=$S($D(^DG(40.8,DIV,0)):DIV,1:0)

 ;

 S WARD=$S($D(^DIC(42,+DGW,0)):$P(^(0),"^"),1:+DGW)

 ;

 S TREAT=$S($D(^DIC(45.7,DGTS,0)):$P(^(0),"^"),1:"UNKNOWN")

 I TREAT="UNKNOWN" S DGTS=9999999999

 ;

 S (PASS,AA,UA,ASIH)=0,MVT=""

 ;

MVT I $D(DGXFR0) S MVT=$P(DGXFR0,"^",18)

 I MVT=1 S PASS=1,MVT="PASS"

 I MVT=2!(MVT=26) S AA=1,MVT="AA"

 I MVT=3!(MVT=25) S UA=1,MVT="UA"

 I "^13^43^44^45^"[("^"_MVT_"^") S ASIH=1,MVT="ASIH"

 I MVT'["A" S MVT="" ; if not one of the above absence reset to null

 ;

PT S PT=$P(^DPT(DFN,0),"^")

 S Y=+$P(DGCA,"^") X ^DD("DD") S ADMDT=$P(Y,"@")

 ;

 I DGTS=9999999999 S SV=0 Q

 ;

SV S SV=$S($D(^DIC(42.4,$P(^DIC(45.7,DGTS,0),"^",2),0)):$P(^DIC(42.4,$P(^DIC(45.7,DGTS,0),"^",2),0),"^",3),1:0)

 ;

 I SV=0 Q

 ;

 S S=SV

 ;

 S SV=$S(S="M":"MEDICINE",S="S":"SURGERY",S="P":"PSYCHIATRY",S="NH":"NHCU",S="NE":"NEUROLOGY",S="I":"INTERMEDIATE MED",S="R":"REHAB MEDICINE",S="SCI":"SPINAL CORD INJURY",S="D":"DOMICILIARY",S="B":"BLIND REHAB",S="RE":"RESPITE CARE",1:"")

 ;

END K DG2,DGA1,DGDA,DGID,DGS,DGX,DGXFR0,TSXDT,S,Y Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPMTSI1   1251     printed  Apr 09, 2024@21:54:26                                                                                                                                                                                                    Page 2

DGPMTSI1  ;ALB/LM - TREATING SPECIALTY INPATIENT SET ; 3/10/93

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2       ;

 +3        QUIT 

START      SET DIV=$SELECT($PIECE(^DIC(42,+DGW,0),"^",11)]"":$PIECE(^DIC(42,+DGW,0),"^",11),1:0)

 +1        SET DIV=$SELECT($DATA(^DG(40.8,DIV,0)):DIV,1:0)

 +2       ;

 +3        SET WARD=$SELECT($DATA(^DIC(42,+DGW,0)):$PIECE(^(0),"^"),1:+DGW)

 +4       ;

 +5        SET TREAT=$SELECT($DATA(^DIC(45.7,DGTS,0)):$PIECE(^(0),"^"),1:"UNKNOWN")

 +6        IF TREAT="UNKNOWN"

               SET DGTS=9999999999

 +7       ;

 +8        SET (PASS,AA,UA,ASIH)=0

           SET MVT=""

 +9       ;

MVT        IF $DATA(DGXFR0)

               SET MVT=$PIECE(DGXFR0,"^",18)

 +1        IF MVT=1

               SET PASS=1

               SET MVT="PASS"

 +2        IF MVT=2!(MVT=26)

               SET AA=1

               SET MVT="AA"

 +3        IF MVT=3!(MVT=25)

               SET UA=1

               SET MVT="UA"

 +4        IF "^13^43^44^45^"[("^"_MVT_"^")

               SET ASIH=1

               SET MVT="ASIH"

 +5       ; if not one of the above absence reset to null

           IF MVT'["A"

               SET MVT=""

 +6       ;

PT         SET PT=$PIECE(^DPT(DFN,0),"^")

 +1        SET Y=+$PIECE(DGCA,"^")

           XECUTE ^DD("DD")

           SET ADMDT=$PIECE(Y,"@")

 +2       ;

 +3        IF DGTS=9999999999

               SET SV=0

               QUIT 

 +4       ;

SV         SET SV=$SELECT($DATA(^DIC(42.4,$PIECE(^DIC(45.7,DGTS,0),"^",2),0)):$PIECE(^DIC(42.4,$PIECE(^DIC(45.7,DGTS,0),"^",2),0),"^",3),1:0)

 +1       ;

 +2        IF SV=0

               QUIT 

 +3       ;

 +4        SET S=SV

 +5       ;

 +6        SET SV=$SELECT(S="M":"MEDICINE",S="S":"SURGERY",S="P":"PSYCHIATRY",S="NH":"NHCU",S="NE":"NEUROLOGY",S="I":"INTERMEDIATE MED",S="R":"REHAB MEDICINE",S="SCI":"SPINAL CORD INJURY",S="D":"DOMICILIARY",S="B":"BLIND REHAB",S="RE":"RESPITE CARE",1:"")

 +7       ;

END        KILL DG2,DGA1,DGDA,DGID,DGS,DGX,DGXFR0,TSXDT,S,Y

           QUIT