- DGPMTSR2 ;ALB/LM - TREATING SPECIALTY REPORT SET ; 3/1/93
- ;;5.3;Registration;;Aug 13, 1993
- ;
- A ; This will set ^TMP("TSR") = TREATING SPECIALTY TOTALS
- ; ^TMP("TSRS") = SERVICE TOTALS
- ; ^TMP("TSRD") = DIVISION TOTALS
- ; ^TMP("TSRG") = GRAND TOTAL
- Q
- ;
- START ; Pats Remaining (Previous Date)
- S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",2)=+$P(CN1,"^",2)
- S $P(^TMP("TSRS",$J,D,S),"^",2)=$P(^TMP("TSRS",$J,D,S),"^",2)+$P(CN1,"^",2)
- S $P(^TMP("TSRD",$J,D),"^",2)=$P(^TMP("TSRD",$J,D),"^",2)+$P(CN1,"^",2)
- S $P(^TMP("TSRG",$J),"^",2)=$P(^TMP("TSRG",$J),"^",2)+$P(CN1,"^",2)
- ;
- GAINS ; Gains Total Cum (new) - Gains Total Cum (previous)
- S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",3)=$P(CN,"^",28)-$P(CN1,"^",28)
- S $P(^TMP("TSRS",$J,D,S),"^",3)=$P(^TMP("TSRS",$J,D,S),"^",3)+$P(CN,"^",28)-$P(CN1,"^",28)
- S $P(^TMP("TSRD",$J,D),"^",3)=$P(^TMP("TSRD",$J,D),"^",3)+$P(CN,"^",28)-$P(CN1,"^",28)
- S $P(^TMP("TSRG",$J),"^",3)=$P(^TMP("TSRG",$J),"^",3)+$P(CN,"^",28)-$P(CN1,"^",28)
- ;
- LOSSES ; losses (new) - losses (previous)
- S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",4)=$P(CN,"^",24)-$P(CN1,"^",24)
- S $P(^TMP("TSRS",$J,D,S),"^",4)=$P(^TMP("TSRS",$J,D,S),"^",4)+$P(CN,"^",24)-$P(CN1,"^",24)
- S $P(^TMP("TSRD",$J,D),"^",4)=$P(^TMP("TSRD",$J,D),"^",4)+$P(CN,"^",24)-$P(CN1,"^",24)
- S $P(^TMP("TSRG",$J),"^",4)=$P(^TMP("TSRG",$J),"^",4)+$P(CN,"^",24)-$P(CN1,"^",24)
- ;
- CURRENT ; Patients Remaining
- S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",5)=+$P(CN,"^",2)
- S $P(^TMP("TSRS",$J,D,S),"^",5)=$P(^TMP("TSRS",$J,D,S),"^",5)+$P(CN,"^",2)
- S $P(^TMP("TSRD",$J,D),"^",5)=$P(^TMP("TSRD",$J,D),"^",5)+$P(CN,"^",2)
- S $P(^TMP("TSRG",$J),"^",5)=$P(^TMP("TSRG",$J),"^",5)+$P(CN,"^",2)
- ;
- PASS S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",6)=+$P(CN(1),"^",5)
- S $P(^TMP("TSRS",$J,D,S),"^",6)=$P(^TMP("TSRS",$J,D,S),"^",6)+$P(CN(1),"^",5)
- S $P(^TMP("TSRD",$J,D),"^",6)=$P(^TMP("TSRD",$J,D),"^",6)+$P(CN(1),"^",5)
- S $P(^TMP("TSRG",$J),"^",6)=$P(^TMP("TSRG",$J),"^",6)+$P(CN(1),"^",5)
- ;
- AA S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",7)=+$P(CN(1),"^",6)
- S $P(^TMP("TSRS",$J,D,S),"^",7)=$P(^TMP("TSRS",$J,D,S),"^",7)+$P(CN(1),"^",6)
- S $P(^TMP("TSRD",$J,D),"^",7)=$P(^TMP("TSRD",$J,D),"^",7)+$P(CN(1),"^",6)
- S $P(^TMP("TSRG",$J),"^",7)=$P(^TMP("TSRG",$J),"^",7)+$P(CN(1),"^",6)
- ;
- UA S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",8)=+$P(CN(1),"^",7)
- S $P(^TMP("TSRS",$J,D,S),"^",8)=$P(^TMP("TSRS",$J,D,S),"^",8)+$P(CN(1),"^",7)
- S $P(^TMP("TSRD",$J,D),"^",8)=$P(^TMP("TSRD",$J,D),"^",8)+$P(CN(1),"^",7)
- S $P(^TMP("TSRG",$J),"^",8)=$P(^TMP("TSRG",$J),"^",8)+$P(CN(1),"^",7)
- ;
- ASIH S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",9)=+$P(CN(1),"^",8)
- S $P(^TMP("TSRS",$J,D,S),"^",9)=$P(^TMP("TSRS",$J,D,S),"^",9)+$P(CN(1),"^",8)
- S $P(^TMP("TSRD",$J,D),"^",9)=$P(^TMP("TSRD",$J,D),"^",9)+$P(CN(1),"^",8)
- S $P(^TMP("TSRG",$J),"^",9)=$P(^TMP("TSRG",$J),"^",9)+$P(CN(1),"^",8)
- ;
- ADC S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",10)=ADC("P")
- S $P(^TMP("TSRS",$J,D,S),"^",10)=ADC("S")
- S $P(^TMP("TSRD",$J,D),"^",10)=ADC("D")
- S $P(^TMP("TSRG",$J),"^",10)=ADC("G")
- ;
- CUM S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",12)=BD("P")
- S $P(^TMP("TSRS",$J,D,S),"^",12)=BD("S")
- S $P(^TMP("TSRD",$J,D),"^",12)=BD("D")
- S $P(^TMP("TSRG",$J),"^",12)=BD("G")
- ;
- ; formats ADC number into comma output
- COMMA S X=$P(^TMP("TSR",$J,D,S,ORDER,TS),"^",12) D COMMA^%DTC S $P(^TMP("TSR",$J,D,S,ORDER,TS),"^",11)=$P(X,".")
- S X=$P(^TMP("TSRS",$J,D,S),"^",12) D COMMA^%DTC S $P(^TMP("TSRS",$J,D,S),"^",11)=$P(X,".")
- S X=$P(^TMP("TSRD",$J,D),"^",12) D COMMA^%DTC S $P(^TMP("TSRD",$J,D),"^",11)=$P(X,".")
- S X=$P(^TMP("TSRG",$J),"^",12) D COMMA^%DTC S $P(^TMP("TSRG",$J),"^",11)=$P(X,".")
- ;
- END Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMTSR2 3705 printed Feb 19, 2025@00:16:05 Page 2
- DGPMTSR2 ;ALB/LM - TREATING SPECIALTY REPORT SET ; 3/1/93
- +1 ;;5.3;Registration;;Aug 13, 1993
- +2 ;
- A ; This will set ^TMP("TSR") = TREATING SPECIALTY TOTALS
- +1 ; ^TMP("TSRS") = SERVICE TOTALS
- +2 ; ^TMP("TSRD") = DIVISION TOTALS
- +3 ; ^TMP("TSRG") = GRAND TOTAL
- +4 QUIT
- +5 ;
- START ; Pats Remaining (Previous Date)
- +1 SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",2)=+$PIECE(CN1,"^",2)
- +2 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",2)=$PIECE(^TMP("TSRS",$JOB,D,S),"^",2)+$PIECE(CN1,"^",2)
- +3 SET $PIECE(^TMP("TSRD",$JOB,D),"^",2)=$PIECE(^TMP("TSRD",$JOB,D),"^",2)+$PIECE(CN1,"^",2)
- +4 SET $PIECE(^TMP("TSRG",$JOB),"^",2)=$PIECE(^TMP("TSRG",$JOB),"^",2)+$PIECE(CN1,"^",2)
- +5 ;
- GAINS ; Gains Total Cum (new) - Gains Total Cum (previous)
- +1 SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",3)=$PIECE(CN,"^",28)-$PIECE(CN1,"^",28)
- +2 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",3)=$PIECE(^TMP("TSRS",$JOB,D,S),"^",3)+$PIECE(CN,"^",28)-$PIECE(CN1,"^",28)
- +3 SET $PIECE(^TMP("TSRD",$JOB,D),"^",3)=$PIECE(^TMP("TSRD",$JOB,D),"^",3)+$PIECE(CN,"^",28)-$PIECE(CN1,"^",28)
- +4 SET $PIECE(^TMP("TSRG",$JOB),"^",3)=$PIECE(^TMP("TSRG",$JOB),"^",3)+$PIECE(CN,"^",28)-$PIECE(CN1,"^",28)
- +5 ;
- LOSSES ; losses (new) - losses (previous)
- +1 SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",4)=$PIECE(CN,"^",24)-$PIECE(CN1,"^",24)
- +2 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",4)=$PIECE(^TMP("TSRS",$JOB,D,S),"^",4)+$PIECE(CN,"^",24)-$PIECE(CN1,"^",24)
- +3 SET $PIECE(^TMP("TSRD",$JOB,D),"^",4)=$PIECE(^TMP("TSRD",$JOB,D),"^",4)+$PIECE(CN,"^",24)-$PIECE(CN1,"^",24)
- +4 SET $PIECE(^TMP("TSRG",$JOB),"^",4)=$PIECE(^TMP("TSRG",$JOB),"^",4)+$PIECE(CN,"^",24)-$PIECE(CN1,"^",24)
- +5 ;
- CURRENT ; Patients Remaining
- +1 SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",5)=+$PIECE(CN,"^",2)
- +2 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",5)=$PIECE(^TMP("TSRS",$JOB,D,S),"^",5)+$PIECE(CN,"^",2)
- +3 SET $PIECE(^TMP("TSRD",$JOB,D),"^",5)=$PIECE(^TMP("TSRD",$JOB,D),"^",5)+$PIECE(CN,"^",2)
- +4 SET $PIECE(^TMP("TSRG",$JOB),"^",5)=$PIECE(^TMP("TSRG",$JOB),"^",5)+$PIECE(CN,"^",2)
- +5 ;
- PASS SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",6)=+$PIECE(CN(1),"^",5)
- +1 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",6)=$PIECE(^TMP("TSRS",$JOB,D,S),"^",6)+$PIECE(CN(1),"^",5)
- +2 SET $PIECE(^TMP("TSRD",$JOB,D),"^",6)=$PIECE(^TMP("TSRD",$JOB,D),"^",6)+$PIECE(CN(1),"^",5)
- +3 SET $PIECE(^TMP("TSRG",$JOB),"^",6)=$PIECE(^TMP("TSRG",$JOB),"^",6)+$PIECE(CN(1),"^",5)
- +4 ;
- AA SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",7)=+$PIECE(CN(1),"^",6)
- +1 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",7)=$PIECE(^TMP("TSRS",$JOB,D,S),"^",7)+$PIECE(CN(1),"^",6)
- +2 SET $PIECE(^TMP("TSRD",$JOB,D),"^",7)=$PIECE(^TMP("TSRD",$JOB,D),"^",7)+$PIECE(CN(1),"^",6)
- +3 SET $PIECE(^TMP("TSRG",$JOB),"^",7)=$PIECE(^TMP("TSRG",$JOB),"^",7)+$PIECE(CN(1),"^",6)
- +4 ;
- UA SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",8)=+$PIECE(CN(1),"^",7)
- +1 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",8)=$PIECE(^TMP("TSRS",$JOB,D,S),"^",8)+$PIECE(CN(1),"^",7)
- +2 SET $PIECE(^TMP("TSRD",$JOB,D),"^",8)=$PIECE(^TMP("TSRD",$JOB,D),"^",8)+$PIECE(CN(1),"^",7)
- +3 SET $PIECE(^TMP("TSRG",$JOB),"^",8)=$PIECE(^TMP("TSRG",$JOB),"^",8)+$PIECE(CN(1),"^",7)
- +4 ;
- ASIH SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",9)=+$PIECE(CN(1),"^",8)
- +1 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",9)=$PIECE(^TMP("TSRS",$JOB,D,S),"^",9)+$PIECE(CN(1),"^",8)
- +2 SET $PIECE(^TMP("TSRD",$JOB,D),"^",9)=$PIECE(^TMP("TSRD",$JOB,D),"^",9)+$PIECE(CN(1),"^",8)
- +3 SET $PIECE(^TMP("TSRG",$JOB),"^",9)=$PIECE(^TMP("TSRG",$JOB),"^",9)+$PIECE(CN(1),"^",8)
- +4 ;
- ADC SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",10)=ADC("P")
- +1 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",10)=ADC("S")
- +2 SET $PIECE(^TMP("TSRD",$JOB,D),"^",10)=ADC("D")
- +3 SET $PIECE(^TMP("TSRG",$JOB),"^",10)=ADC("G")
- +4 ;
- CUM SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",12)=BD("P")
- +1 SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",12)=BD("S")
- +2 SET $PIECE(^TMP("TSRD",$JOB,D),"^",12)=BD("D")
- +3 SET $PIECE(^TMP("TSRG",$JOB),"^",12)=BD("G")
- +4 ;
- +5 ; formats ADC number into comma output
- COMMA SET X=$PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",12)
- DO COMMA^%DTC
- SET $PIECE(^TMP("TSR",$JOB,D,S,ORDER,TS),"^",11)=$PIECE(X,".")
- +1 SET X=$PIECE(^TMP("TSRS",$JOB,D,S),"^",12)
- DO COMMA^%DTC
- SET $PIECE(^TMP("TSRS",$JOB,D,S),"^",11)=$PIECE(X,".")
- +2 SET X=$PIECE(^TMP("TSRD",$JOB,D),"^",12)
- DO COMMA^%DTC
- SET $PIECE(^TMP("TSRD",$JOB,D),"^",11)=$PIECE(X,".")
- +3 SET X=$PIECE(^TMP("TSRG",$JOB),"^",12)
- DO COMMA^%DTC
- SET $PIECE(^TMP("TSRG",$JOB),"^",11)=$PIECE(X,".")
- +4 ;
- END QUIT