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 ---[H[J[2J[HDGPMTSI1 1251 printed Dec 13, 2024@02:49:55 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
