PXRHS13.m

PXRHS13 ;ISL/SBW - PCE Patient Location of Home extract ;6/7/96

 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996

LOC(DFN) ; Control branching

 ;INPUT  : DFN      - Pointer to PATIENT file (#2)

 ;OUTPUT : 

 ;  Data from PATIENT/IHS FILE (9000001) file

 ;  ^TMP("PXLOC",$J,LINE#) = LOCATION OF HOME [E;1201]

 ;

 Q:$G(DFN)']""!'$O(^AUPNPAT(DFN,12,0))

 N DIC,DIQ,DR,DA,REC,CNT

 K ^TMP("PXLOC",$J)

 S DIC=9000001,DA=DFN,DIQ="REC("

 S DR=1201

 D EN^DIQ1

 Q:'$D(REC)

 S CNT=0

 F  S CNT=$O(REC(9000001,DFN,1201,CNT)) Q:CNT'>0  D

 . S ^TMP("PXLOC",$J,CNT)=$G(REC(9000001,DFN,1201,CNT))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRHS13   598     printed  Dec 13, 2024@02:30:31                                                                                                                                                                                                      Page 2

PXRHS13   ;ISL/SBW - PCE Patient Location of Home extract ;6/7/96

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996

LOC(DFN)  ; Control branching

 +1       ;INPUT  : DFN      - Pointer to PATIENT file (#2)

 +2       ;OUTPUT : 

 +3       ;  Data from PATIENT/IHS FILE (9000001) file

 +4       ;  ^TMP("PXLOC",$J,LINE#) = LOCATION OF HOME [E;1201]

 +5       ;

 +6        if $GET(DFN)']""!'$ORDER(^AUPNPAT(DFN,12,0))

               QUIT 

 +7        NEW DIC,DIQ,DR,DA,REC,CNT

 +8        KILL ^TMP("PXLOC",$JOB)

 +9        SET DIC=9000001

           SET DA=DFN

           SET DIQ="REC("

 +10       SET DR=1201

 +11       DO EN^DIQ1

 +12       if '$DATA(REC)

               QUIT 

 +13       SET CNT=0

 +14       FOR 

               SET CNT=$ORDER(REC(9000001,DFN,1201,CNT))

               if CNT'>0

                   QUIT 

               Begin DoDot:1

 +15               SET ^TMP("PXLOC",$JOB,CNT)=$GET(REC(9000001,DFN,1201,CNT))

               End DoDot:1

 +16       QUIT