DGPTPXRM.m

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 ---DGPTPXRM   750     printed  Apr 09, 2024@21:38:10                                                                                                                                                                                                     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      ;