DGPMTSI2 ;ALB/LM - TREATING SPECIALTY INPATIENT SET ; 3/10/93
;;5.3;Registration;;Aug 13, 1993
;
Q
START ;
D PTLWD,PTLTS,PTCTS
;
END K AA,ASIH,PASS,UA,MVT,PT,SV,SV1,TREAT,WARD Q
;
;
PTLWD Q:'PTLWD ; Patient Listing by Wards
S ^TMP($J,"PTLWD",DIV)=$S($D(^TMP($J,"PTLWD",DIV)):^TMP($J,"PTLWD",DIV),1:0)
S $P(^TMP($J,"PTLWD",DIV),"^",1)=$P(^TMP($J,"PTLWD",DIV),"^",1)+1
S $P(^TMP($J,"PTLWD",DIV),"^",2)=$P(^TMP($J,"PTLWD",DIV),"^",2)+PASS
S $P(^TMP($J,"PTLWD",DIV),"^",3)=$P(^TMP($J,"PTLWD",DIV),"^",3)+AA
S $P(^TMP($J,"PTLWD",DIV),"^",4)=$P(^TMP($J,"PTLWD",DIV),"^",4)+UA
S $P(^TMP($J,"PTLWD",DIV),"^",5)=$P(^TMP($J,"PTLWD",DIV),"^",5)+ASIH
S ^TMP($J,"PTLWD",DIV,WARD,+DGW)=$S($D(^TMP($J,"PTLWD",DIV,WARD,+DGW)):^TMP($J,"PTLWD",DIV,WARD,+DGW),1:0)
S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",1)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",1)+1
S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",2)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",2)+PASS
S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",3)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",3)+AA
S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",4)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",4)+UA
S $P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",5)=$P(^TMP($J,"PTLWD",DIV,WARD,+DGW),"^",5)+ASIH
S ^TMP($J,"PTLWD",DIV,WARD,+DGW,PT,DFN)=TREAT_"^"_ADMDT_"^"_$S(SV'=0:SV,1:"")_"^"_MVT
Q
;
PTLTS Q:'PTLTS ; Patient Listing by Treating Specialty
S ^TMP($J,"PTLTS",DIV)=$S($D(^TMP($J,"PTLTS",DIV)):^TMP($J,"PTLTS",DIV),1:0)
S $P(^TMP($J,"PTLTS",DIV),"^",1)=$P(^TMP($J,"PTLTS",DIV),"^",1)+1
S $P(^TMP($J,"PTLTS",DIV),"^",2)=$P(^TMP($J,"PTLTS",DIV),"^",2)+PASS
S $P(^TMP($J,"PTLTS",DIV),"^",3)=$P(^TMP($J,"PTLTS",DIV),"^",3)+AA
S $P(^TMP($J,"PTLTS",DIV),"^",4)=$P(^TMP($J,"PTLTS",DIV),"^",4)+UA
S $P(^TMP($J,"PTLTS",DIV),"^",5)=$P(^TMP($J,"PTLTS",DIV),"^",5)+ASIH
S ^TMP($J,"PTLTS",DIV,TREAT,DGTS)=$S($D(^TMP($J,"PTLTS",DIV,TREAT,DGTS)):^TMP($J,"PTLTS",DIV,TREAT,DGTS),1:0)
S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",1)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",1)+1
S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",2)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",2)+PASS
S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",3)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",3)+AA
S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",4)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",4)+UA
S $P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",5)=$P(^TMP($J,"PTLTS",DIV,TREAT,DGTS),"^",5)+ASIH
S ^TMP($J,"PTLTS",DIV,TREAT,DGTS,PT,DFN)=WARD_"^"_ADMDT_"^"_$S(SV'=0:SV,1:"")_"^"_MVT
Q
;
PTCTS Q:'PTCTS ; Patient Counts by Treating Specialty
S ^TMP($J,"PTCTS",DIV)=$S($D(^TMP($J,"PTCTS",DIV)):^TMP($J,"PTCTS",DIV),1:0)
S $P(^TMP($J,"PTCTS",DIV),"^",1)=$P(^TMP($J,"PTCTS",DIV),"^",1)+1
S $P(^TMP($J,"PTCTS",DIV),"^",2)=$P(^TMP($J,"PTCTS",DIV),"^",2)+PASS
S $P(^TMP($J,"PTCTS",DIV),"^",3)=$P(^TMP($J,"PTCTS",DIV),"^",3)+AA
S $P(^TMP($J,"PTCTS",DIV),"^",4)=$P(^TMP($J,"PTCTS",DIV),"^",4)+UA
S $P(^TMP($J,"PTCTS",DIV),"^",5)=$P(^TMP($J,"PTCTS",DIV),"^",5)+ASIH
S ^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV)=$S($D(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV)):^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),1:0)
S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",1)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",1)+1
S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",2)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",2)+PASS
S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",3)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",3)+AA
S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",4)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",4)+UA
S $P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",5)=$P(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV),"^",5)+ASIH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMTSI2 3569 printed Dec 13, 2024@02:49:56 Page 2
DGPMTSI2 ;ALB/LM - TREATING SPECIALTY INPATIENT SET ; 3/10/93
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
+3 QUIT
START ;
+1 DO PTLWD
DO PTLTS
DO PTCTS
+2 ;
END KILL AA,ASIH,PASS,UA,MVT,PT,SV,SV1,TREAT,WARD
QUIT
+1 ;
+2 ;
PTLWD ; Patient Listing by Wards
if 'PTLWD
QUIT
+1 SET ^TMP($JOB,"PTLWD",DIV)=$SELECT($DATA(^TMP($JOB,"PTLWD",DIV)):^TMP($JOB,"PTLWD",DIV),1:0)
+2 SET $PIECE(^TMP($JOB,"PTLWD",DIV),"^",1)=$PIECE(^TMP($JOB,"PTLWD",DIV),"^",1)+1
+3 SET $PIECE(^TMP($JOB,"PTLWD",DIV),"^",2)=$PIECE(^TMP($JOB,"PTLWD",DIV),"^",2)+PASS
+4 SET $PIECE(^TMP($JOB,"PTLWD",DIV),"^",3)=$PIECE(^TMP($JOB,"PTLWD",DIV),"^",3)+AA
+5 SET $PIECE(^TMP($JOB,"PTLWD",DIV),"^",4)=$PIECE(^TMP($JOB,"PTLWD",DIV),"^",4)+UA
+6 SET $PIECE(^TMP($JOB,"PTLWD",DIV),"^",5)=$PIECE(^TMP($JOB,"PTLWD",DIV),"^",5)+ASIH
+7 SET ^TMP($JOB,"PTLWD",DIV,WARD,+DGW)=$SELECT($DATA(^TMP($JOB,"PTLWD",DIV,WARD,+DGW)):^TMP($JOB,"PTLWD",DIV,WARD,+DGW),1:0)
+8 SET $PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",1)=$PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",1)+1
+9 SET $PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",2)=$PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",2)+PASS
+10 SET $PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",3)=$PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",3)+AA
+11 SET $PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",4)=$PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",4)+UA
+12 SET $PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",5)=$PIECE(^TMP($JOB,"PTLWD",DIV,WARD,+DGW),"^",5)+ASIH
+13 SET ^TMP($JOB,"PTLWD",DIV,WARD,+DGW,PT,DFN)=TREAT_"^"_ADMDT_"^"_$SELECT(SV'=0:SV,1:"")_"^"_MVT
+14 QUIT
+15 ;
PTLTS ; Patient Listing by Treating Specialty
if 'PTLTS
QUIT
+1 SET ^TMP($JOB,"PTLTS",DIV)=$SELECT($DATA(^TMP($JOB,"PTLTS",DIV)):^TMP($JOB,"PTLTS",DIV),1:0)
+2 SET $PIECE(^TMP($JOB,"PTLTS",DIV),"^",1)=$PIECE(^TMP($JOB,"PTLTS",DIV),"^",1)+1
+3 SET $PIECE(^TMP($JOB,"PTLTS",DIV),"^",2)=$PIECE(^TMP($JOB,"PTLTS",DIV),"^",2)+PASS
+4 SET $PIECE(^TMP($JOB,"PTLTS",DIV),"^",3)=$PIECE(^TMP($JOB,"PTLTS",DIV),"^",3)+AA
+5 SET $PIECE(^TMP($JOB,"PTLTS",DIV),"^",4)=$PIECE(^TMP($JOB,"PTLTS",DIV),"^",4)+UA
+6 SET $PIECE(^TMP($JOB,"PTLTS",DIV),"^",5)=$PIECE(^TMP($JOB,"PTLTS",DIV),"^",5)+ASIH
+7 SET ^TMP($JOB,"PTLTS",DIV,TREAT,DGTS)=$SELECT($DATA(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS)):^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),1:0)
+8 SET $PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",1)=$PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",1)+1
+9 SET $PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",2)=$PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",2)+PASS
+10 SET $PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",3)=$PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",3)+AA
+11 SET $PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",4)=$PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",4)+UA
+12 SET $PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",5)=$PIECE(^TMP($JOB,"PTLTS",DIV,TREAT,DGTS),"^",5)+ASIH
+13 SET ^TMP($JOB,"PTLTS",DIV,TREAT,DGTS,PT,DFN)=WARD_"^"_ADMDT_"^"_$SELECT(SV'=0:SV,1:"")_"^"_MVT
+14 QUIT
+15 ;
PTCTS ; Patient Counts by Treating Specialty
if 'PTCTS
QUIT
+1 SET ^TMP($JOB,"PTCTS",DIV)=$SELECT($DATA(^TMP($JOB,"PTCTS",DIV)):^TMP($JOB,"PTCTS",DIV),1:0)
+2 SET $PIECE(^TMP($JOB,"PTCTS",DIV),"^",1)=$PIECE(^TMP($JOB,"PTCTS",DIV),"^",1)+1
+3 SET $PIECE(^TMP($JOB,"PTCTS",DIV),"^",2)=$PIECE(^TMP($JOB,"PTCTS",DIV),"^",2)+PASS
+4 SET $PIECE(^TMP($JOB,"PTCTS",DIV),"^",3)=$PIECE(^TMP($JOB,"PTCTS",DIV),"^",3)+AA
+5 SET $PIECE(^TMP($JOB,"PTCTS",DIV),"^",4)=$PIECE(^TMP($JOB,"PTCTS",DIV),"^",4)+UA
+6 SET $PIECE(^TMP($JOB,"PTCTS",DIV),"^",5)=$PIECE(^TMP($JOB,"PTCTS",DIV),"^",5)+ASIH
+7 SET ^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV)=$SELECT($DATA(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV)):^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),1:0)
+8 SET $PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",1)=$PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",1)+1
+9 SET $PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",2)=$PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",2)+PASS
+10 SET $PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",3)=$PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",3)+AA
+11 SET $PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",4)=$PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",4)+UA
+12 SET $PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",5)=$PIECE(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV),"^",5)+ASIH
+13 QUIT
