DGPTPXRM ;SLC/PKR - Routines for Clinical Reminder index. ;09/30/2004
;;5.3;Registration;**478**;Aug 13, 1993
;===========================================================
PTF(DAS,DATA) ;Return data for a PTF entry
N D0,TEMP
S D0=$P(DAS,";",1)
S TEMP=^DGPT(D0,0)
S DATA("ADMISSION DATE")=$P(TEMP,U,2)
S DATA("FACILITY")=$P(TEMP,U,3)
S DATA("FEE BASIS")=$P(TEMP,U,4)
I $D(^DGPT(D0,70)) D
. S TEMP=$G(^DGPT(D0,70))
. S DATA("DISCHARGE DATE")=$P(TEMP,U,1)
. S DATA("DISCHARGE SPECIALITY")=$P(TEMP,U,2)
. S DATA("DISCHARGE STATUS")=$P(TEMP,U,14)
. S DATA("DISCHARGE PROVIDER")=$P(TEMP,U,15)
I DAS["M" D
. N D1
. S D1=$P(DAS,";",3)
. S TEMP=^DGPT(D0,"M",D1,0)
. S DATA("MOVEMENT RECORD")=$P(TEMP,U,1)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTPXRM 750 printed Nov 22, 2024@18:03:20 Page 2
DGPTPXRM ;SLC/PKR - Routines for Clinical Reminder index. ;09/30/2004
+1 ;;5.3;Registration;**478**;Aug 13, 1993
+2 ;===========================================================
PTF(DAS,DATA) ;Return data for a PTF entry
+1 NEW D0,TEMP
+2 SET D0=$PIECE(DAS,";",1)
+3 SET TEMP=^DGPT(D0,0)
+4 SET DATA("ADMISSION DATE")=$PIECE(TEMP,U,2)
+5 SET DATA("FACILITY")=$PIECE(TEMP,U,3)
+6 SET DATA("FEE BASIS")=$PIECE(TEMP,U,4)
+7 IF $DATA(^DGPT(D0,70))
Begin DoDot:1
+8 SET TEMP=$GET(^DGPT(D0,70))
+9 SET DATA("DISCHARGE DATE")=$PIECE(TEMP,U,1)
+10 SET DATA("DISCHARGE SPECIALITY")=$PIECE(TEMP,U,2)
+11 SET DATA("DISCHARGE STATUS")=$PIECE(TEMP,U,14)
+12 SET DATA("DISCHARGE PROVIDER")=$PIECE(TEMP,U,15)
End DoDot:1
+13 IF DAS["M"
Begin DoDot:1
+14 NEW D1
+15 SET D1=$PIECE(DAS,";",3)
+16 SET TEMP=^DGPT(D0,"M",D1,0)
+17 SET DATA("MOVEMENT RECORD")=$PIECE(TEMP,U,1)
End DoDot:1
+18 QUIT
+19 ;
