RMPR29W2.m

RMPR29W2 ;HOIFO/SPS -  WORK ORDER MATERIAL GRID OWL PROGRAM ;11/8/05  07:12

 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25

 ;

 ;

A1(RMPR6642) ;entry point for testing

 D A2

 Q

EN(RESULT,RMPR6642) ; -- Broker callback to get list to display

A2 N STRING,CLREND,COLUMN,ON,OFF

 S DATE=2010101

 ;S SITE="ALL",START=00,STOP=99

 K ^TMP($J)

 N RMPRA,CDATE,X

 S (CNT,VALMCNT)=0,RRX=""

 I '$D(^RMPR(664.2,RMPR6642,0)) Q

 D REC

 G EXIT

 Q

REC ;records to grid

 ;stop date, init action date

 ;check ien, patch 77

 ;

 ;

 N DIC,DIQ,DR,STOPDT

 ;

 ;Get Work Order Data and add to array

 S RMPRAON="" F  S RMPRAON=$O(^RMPR(664.2,RMPR6642,1,RMPRAON)) Q:RMPRAON=""  D

 . Q:'$D(^RMPR(664.2,RMPR6642,1,RMPRAON,0))

 . S CNT=CNT+1

 . S RMPRII=^RMPR(664.2,RMPR6642,1,RMPRAON,0)

 . ;Internal and external Material

 . S RMPRMI=$P(RMPRII,U),RMPRSME=$$EXTERNAL^DILFD(664.22,.01,"",RMPRMI)

 . ;Internal/external unit of issue

 . S RMPRUI=$P(RMPRII,U,7),RMPRUIE=$$EXTERNAL^DILFD(664.22,6,"",RMPRUI)

 . ;Internal/external Vendor

 . S RMPRVI=$P(RMPRII,U,6),RMPRVE=$$EXTERNAL^DILFD(664.22,5,"",RMPRVI)

 . ;Internal/external patient category

 . ;S RMPRPCI=$P(RMPRII,U,8),RMPRPCE=$$EXTERNAL^DILFD(664.16,9,"",RMPRPCI)

 . ;Internal/External HCPCS

 . ;S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)

 . ;Internal/External CPT Modifier

 . ;S RMPRMI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,2)

 . ;,RMPRPHCE=$$EXTERNAL^DILFD(81.3,"",RMPRME)

 . S ^TMP($J,"RMPRM",CNT)=0_U_RMPRAON_U_RMPRSME_U_$P(RMPRII,U,2)_U_$P(RMPRII,U,3)_U_$P(RMPRII,U,4)_U_RMPRVE_U_RMPRUIE

 . S ^TMP($J,"RMPRM",CNT)=^TMP($J,"RMPRM",CNT)_U_$P(RMPRII,U,8)_U_$P(RMPRII,U,11)_U_$P(RMPRII,U,12)

 K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE

 ;PUT RESULTS IN GLOBAL!!

 Q

 K DNT,DATE,RMPRAON,RMPRII,RMPRMI,RMPRSME,RMPRUI,RMPRUIE,RMPRVE,RMPRVI,RRX,VALMCNT

EXIT ;common exit point

 S RESULT=$NA(^TMP($J))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPR29W2   1938     printed  Apr 09, 2024@21:39:03                                                                                                                                                                                                    Page 2

RMPR29W2  ;HOIFO/SPS -  WORK ORDER MATERIAL GRID OWL PROGRAM ;11/8/05  07:12

 +1       ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25

 +2       ;

 +3       ;

A1(RMPR6642) ;entry point for testing

 +1        DO A2

 +2        QUIT 

EN(RESULT,RMPR6642) ; -- Broker callback to get list to display

A2         NEW STRING,CLREND,COLUMN,ON,OFF

 +1        SET DATE=2010101

 +2       ;S SITE="ALL",START=00,STOP=99

 +3        KILL ^TMP($JOB)

 +4        NEW RMPRA,CDATE,X

 +5        SET (CNT,VALMCNT)=0

           SET RRX=""

 +6        IF '$DATA(^RMPR(664.2,RMPR6642,0))

               QUIT 

 +7        DO REC

 +8        GOTO EXIT

 +9        QUIT 

REC       ;records to grid

 +1       ;stop date, init action date

 +2       ;check ien, patch 77

 +3       ;

 +4       ;

 +5        NEW DIC,DIQ,DR,STOPDT

 +6       ;

 +7       ;Get Work Order Data and add to array

 +8        SET RMPRAON=""

           FOR 

               SET RMPRAON=$ORDER(^RMPR(664.2,RMPR6642,1,RMPRAON))

               if RMPRAON=""

                   QUIT 

               Begin DoDot:1

 +9                if '$DATA(^RMPR(664.2,RMPR6642,1,RMPRAON,0))

                       QUIT 

 +10               SET CNT=CNT+1

 +11               SET RMPRII=^RMPR(664.2,RMPR6642,1,RMPRAON,0)

 +12      ;Internal and external Material

 +13               SET RMPRMI=$PIECE(RMPRII,U)

                   SET RMPRSME=$$EXTERNAL^DILFD(664.22,.01,"",RMPRMI)

 +14      ;Internal/external unit of issue

 +15               SET RMPRUI=$PIECE(RMPRII,U,7)

                   SET RMPRUIE=$$EXTERNAL^DILFD(664.22,6,"",RMPRUI)

 +16      ;Internal/external Vendor

 +17               SET RMPRVI=$PIECE(RMPRII,U,6)

                   SET RMPRVE=$$EXTERNAL^DILFD(664.22,5,"",RMPRVI)

 +18      ;Internal/external patient category

 +19      ;S RMPRPCI=$P(RMPRII,U,8),RMPRPCE=$$EXTERNAL^DILFD(664.16,9,"",RMPRPCI)

 +20      ;Internal/External HCPCS

 +21      ;S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)

 +22      ;Internal/External CPT Modifier

 +23      ;S RMPRMI=$P($G(^RMPR(664.1,RMPR6641,2,RMPRAON,2)),U,2)

 +24      ;,RMPRPHCE=$$EXTERNAL^DILFD(81.3,"",RMPRME)

 +25               SET ^TMP($JOB,"RMPRM",CNT)=0_U_RMPRAON_U_RMPRSME_U_$PIECE(RMPRII,U,2)_U_$PIECE(RMPRII,U,3)_U_$PIECE(RMPRII,U,4)_U_RMPRVE_U_RMPRUIE

 +26               SET ^TMP($JOB,"RMPRM",CNT)=^TMP($JOB,"RMPRM",CNT)_U_$PIECE(RMPRII,U,8)_U_$PIECE(RMPRII,U,11)_U_$PIECE(RMPRII,U,12)

               End DoDot:1

 +27       KILL CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE

 +28      ;PUT RESULTS IN GLOBAL!!

 +29       QUIT 

 +30       KILL DNT,DATE,RMPRAON,RMPRII,RMPRMI,RMPRSME,RMPRUI,RMPRUIE,RMPRVE,RMPRVI,RRX,VALMCNT

EXIT      ;common exit point

 +1        SET RESULT=$NAME(^TMP($JOB))

 +2        QUIT