DGPMTSI2.m

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

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;

 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

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

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +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