- RMPR29WO ;HOIFO/SPS - WORK ORDER GRID OWL PROGRAM ;11/8/05 07:12
- ;;3.0;PROSTHETICS;**75,122,60**;Feb 09, 1996;Build 18
- ;
- ;SORT - STATUS OF 664.1, if CA change to X to check.
- ;
- A1(SORT) ;entry point for testing
- D A2
- Q
- EN(RESULT,SORT) ; -- 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
- K ADATE,PDAY,RMPRCD
- S (CNT,VALMCNT)=0,(RMPR6641,RRX)=""
- F S RMPR6641=$O(^RMPR(664.1,RMPR6641)) Q:RMPR6641="" D
- .I '$D(^RMPR(664.1,RMPR6641,0)) Q
- .I $P(^RMPR(664.1,RMPR6641,0),U,13)="" Q
- .S WO66410=^RMPR(664.1,RMPR6641,0)
- .S RMSTS=$P(WO66410,U,17)
- .I RMSTS="CA" S RMSTS="X"
- .I RMSTS="PC" Q
- .I SORT'[RMSTS Q
- .I RMSTS="X" S RMSTS="CA"
- .S RMSTS=$$EXTERNAL^DILFD(664.1,16,"",RMSTS)
- .S RMRDTI=$P(WO66410,U,9)
- .S RMPRA=$P(WO66410,U,8) Q:RMPRA'>0 D
- ..S STN=$P(^RMPR(668,RMPRA,0),U,7)
- ..S STNX=$$STATN^RMPRUTIL(STN)
- ..;ssn range filter
- ..S DFN=$P(^RMPR(668,RMPRA,0),U,2)
- ..D DEM^VADPT
- ..S SSNEN=$E($P(VADM(2),"^",2),10,11)
- ..I SSNEN>STOP Q
- ..I SSNEN<START Q
- ..K SSNEN,VADM
- ..D REC
- S I=""
- F S I=$O(^TMP($J,I)) Q:I'>0 D
- .Q:'$D(^TMP($J,I))
- .S ^TMP($J,"RMPRWO",CNT)=^TMP($J,I)
- .S CNT=CNT-1
- G EXIT
- Q
- REC ;records to grid
- ;stop date, init action date
- ;check ien, patch 77
- ;
- N DIC,DIQ,DR,STOPDT
- S STOPDT=$P($G(^RMPR(668,RMPRA,0)),U,9),STOPDT=$$DAT2^RMPRUTL1(STOPDT)
- I $D(RMRDTI) S RMRDTE=$$DAT2^RMPRUTL1(RMRDTI)
- S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT2^RMPRUTL1(CDATE)
- S WDATE=$P(^RMPR(664.1,RMPR6641,0),U,1),WDATE=$$DAT2^RMPRUTL1(WDATE)
- S RMWDTI=$P(^RMPR(664.1,RMPR6641,0),U,1)
- S DFN=$P(^RMPR(668,RMPRA,0),U,2) Q:DFN=""
- N VA,VADM
- D DEM^VADPT
- S WHO=VADM(1)
- S SSN=VADM(2)
- D SVC^VADPT
- S RMPROEOI=$S(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
- D KVAR^VADPT
- ;type
- S TYPE=$$TYPE^RMPREOU(RMPRA,8)
- Q:TYPE'["LAB"
- S CNT=CNT+1
- ;display description if manual
- S DES=$$DES^RMPREOU(RMPRA,22)
- S DES=$TR(DES,"^","*")
- S DES=$TR(DES,"""","'")
- ;init action date
- S ADATE="",PDAY="",WRKDAY=""
- S ADATE=$P(^RMPR(668,RMPRA,0),U,9)
- ;PPD=1 for previous pending
- I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA)
- ;
- S LINKED=$P($G(^RMPR(668,RMPRA,10,0)),U,4)
- I LINKED="" S LINKED=0
- ;
- ; Note for list the Variable SSN is in the format NNNNNNNNN^NNN-NN-NNNN
- ; Thus making up 2 pieces of the data string below.
- I RMPROEOI="<!>" S WHO=RMPROEOI_WHO
- S ^TMP($J,RMPR6641)=CDATE_U_DFN_U_WHO_U_SSN_U_TYPE_U_DES
- S ^TMP($J,RMPR6641)=^TMP($J,RMPR6641)_U_RMSTS_U_RMPRA_U_RMPR6641
- ;Get Work Order Data and add to array
- S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,1,0)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)
- S RMPRWN=$P(WO66410,U,13)
- S RMPRROFF=$$EXTERNAL^DILFD(664.1,13,"",$P(WO66410,U,5))
- S RMPRTECH=$$EXTERNAL^DILFD(664.1,13,"",$P(WO66410,U,16))
- S RMPRSOPI=$P(WO66410,U,11),RMPRSOPE=$$EXTERNAL^DILFD(664.1,2,"",RMPRSOPI)
- S RMNPPDSI=$P(WO66410,U,3),RMNPPDSE=$$EXTERNAL^DILFD(664.1,.03,"",RMNPPDSI),RMNPPDSN=$$STATN^RMPRUTIL(RMNPPDSI)
- S RMPRSITE=$O(^RMPR(669.9,"C",RMNPPDSI,0))
- S RMREQSTI=$P(WO66410,U,4),RMREQSTE=$$EXTERNAL^DILFD(664.1,.04,"",RMREQSTI),RMREQSTN=$$STATN^RMPRUTIL(RMREQSTI)
- S RMRECSTI=$P(WO66410,U,15),RMRECSTE=$$EXTERNAL^DILFD(664.1,.11,"",RMRECSTI),RMRECSTN=$$STATN^RMPRUTIL(RMRECSTI)
- S ^TMP($J,RMPR6641)=^TMP($J,RMPR6641)_U_RMPRPHCE_U_RMPRWN_U_RMPRROFF_U_RMPRTECH_U_RMPRSOPE_U_RMNPPDSN_U_RMNPPDSE_U_RMREQSTN_U_RMREQSTE_U_RMRECSTN_U_RMRECSTE_U_RMPRSITE_U_WDATE_U_RMRDTE
- K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE,RMRDTE
- ;PUT RESULTS IN GLOBAL!!
- Q
- K CDAY,CNT,DATE,DFN,I,LINKED,RMNPPDSE,RMNPPDSI,RMNPPDSN,RMPR6641
- K RMPRPHCE,RMPRPHCI,RMPRROFF,RMPRSITE,RMPRSOPE,RMPRSOPI,RMPRTECH
- K RMPRWN,RMPRDTI,RMRECSTE,RMRECSTI,RMRECSTN,RMREQSTE,RMREQSTI
- K RMREQSTN,RMSTS,RMWDTI,RRX,SITE,START,STN,STNX,STOP,VALMCNT,WDATE,WO66410,WRKDAY
- EXIT ;common exit point
- S RESULT=$NA(^TMP($J,"RMPRWO"))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29WO 3952 printed Feb 18, 2025@23:59:01 Page 2
- RMPR29WO ;HOIFO/SPS - WORK ORDER GRID OWL PROGRAM ;11/8/05 07:12
- +1 ;;3.0;PROSTHETICS;**75,122,60**;Feb 09, 1996;Build 18
- +2 ;
- +3 ;SORT - STATUS OF 664.1, if CA change to X to check.
- +4 ;
- A1(SORT) ;entry point for testing
- +1 DO A2
- +2 QUIT
- EN(RESULT,SORT) ; -- Broker callback to get list to display
- A2 NEW STRING,CLREND,COLUMN,ON,OFF
- +1 SET DATE=2010101
- +2 SET SITE="ALL"
- SET START=00
- SET STOP=99
- +3 KILL ^TMP($JOB)
- +4 NEW RMPRA,CDATE,X
- +5 KILL ADATE,PDAY,RMPRCD
- +6 SET (CNT,VALMCNT)=0
- SET (RMPR6641,RRX)=""
- +7 FOR
- SET RMPR6641=$ORDER(^RMPR(664.1,RMPR6641))
- if RMPR6641=""
- QUIT
- Begin DoDot:1
- +8 IF '$DATA(^RMPR(664.1,RMPR6641,0))
- QUIT
- +9 IF $PIECE(^RMPR(664.1,RMPR6641,0),U,13)=""
- QUIT
- +10 SET WO66410=^RMPR(664.1,RMPR6641,0)
- +11 SET RMSTS=$PIECE(WO66410,U,17)
- +12 IF RMSTS="CA"
- SET RMSTS="X"
- +13 IF RMSTS="PC"
- QUIT
- +14 IF SORT'[RMSTS
- QUIT
- +15 IF RMSTS="X"
- SET RMSTS="CA"
- +16 SET RMSTS=$$EXTERNAL^DILFD(664.1,16,"",RMSTS)
- +17 SET RMRDTI=$PIECE(WO66410,U,9)
- +18 SET RMPRA=$PIECE(WO66410,U,8)
- if RMPRA'>0
- QUIT
- Begin DoDot:2
- +19 SET STN=$PIECE(^RMPR(668,RMPRA,0),U,7)
- +20 SET STNX=$$STATN^RMPRUTIL(STN)
- +21 ;ssn range filter
- +22 SET DFN=$PIECE(^RMPR(668,RMPRA,0),U,2)
- +23 DO DEM^VADPT
- +24 SET SSNEN=$EXTRACT($PIECE(VADM(2),"^",2),10,11)
- +25 IF SSNEN>STOP
- QUIT
- +26 IF SSNEN<START
- QUIT
- +27 KILL SSNEN,VADM
- +28 DO REC
- End DoDot:2
- End DoDot:1
- +29 SET I=""
- +30 FOR
- SET I=$ORDER(^TMP($JOB,I))
- if I'>0
- QUIT
- Begin DoDot:1
- +31 if '$DATA(^TMP($JOB,I))
- QUIT
- +32 SET ^TMP($JOB,"RMPRWO",CNT)=^TMP($JOB,I)
- +33 SET CNT=CNT-1
- End DoDot:1
- +34 GOTO EXIT
- +35 QUIT
- REC ;records to grid
- +1 ;stop date, init action date
- +2 ;check ien, patch 77
- +3 ;
- +4 NEW DIC,DIQ,DR,STOPDT
- +5 SET STOPDT=$PIECE($GET(^RMPR(668,RMPRA,0)),U,9)
- SET STOPDT=$$DAT2^RMPRUTL1(STOPDT)
- +6 IF $DATA(RMRDTI)
- SET RMRDTE=$$DAT2^RMPRUTL1(RMRDTI)
- +7 SET CDATE=$PIECE(^RMPR(668,RMPRA,0),U,1)
- SET CDATE=$$DAT2^RMPRUTL1(CDATE)
- +8 SET WDATE=$PIECE(^RMPR(664.1,RMPR6641,0),U,1)
- SET WDATE=$$DAT2^RMPRUTL1(WDATE)
- +9 SET RMWDTI=$PIECE(^RMPR(664.1,RMPR6641,0),U,1)
- +10 SET DFN=$PIECE(^RMPR(668,RMPRA,0),U,2)
- if DFN=""
- QUIT
- +11 NEW VA,VADM
- +12 DO DEM^VADPT
- +13 SET WHO=VADM(1)
- +14 SET SSN=VADM(2)
- +15 DO SVC^VADPT
- +16 SET RMPROEOI=$SELECT(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
- +17 DO KVAR^VADPT
- +18 ;type
- +19 SET TYPE=$$TYPE^RMPREOU(RMPRA,8)
- +20 if TYPE'["LAB"
- QUIT
- +21 SET CNT=CNT+1
- +22 ;display description if manual
- +23 SET DES=$$DES^RMPREOU(RMPRA,22)
- +24 SET DES=$TRANSLATE(DES,"^","*")
- +25 SET DES=$TRANSLATE(DES,"""","'")
- +26 ;init action date
- +27 SET ADATE=""
- SET PDAY=""
- SET WRKDAY=""
- +28 SET ADATE=$PIECE(^RMPR(668,RMPRA,0),U,9)
- +29 ;PPD=1 for previous pending
- +30 IF ADATE'=""
- SET CDAY=$$PDAY^RMPREOU(RMPRA)
- +31 ;
- +32 SET LINKED=$PIECE($GET(^RMPR(668,RMPRA,10,0)),U,4)
- +33 IF LINKED=""
- SET LINKED=0
- +34 ;
- +35 ; Note for list the Variable SSN is in the format NNNNNNNNN^NNN-NN-NNNN
- +36 ; Thus making up 2 pieces of the data string below.
- +37 IF RMPROEOI="<!>"
- SET WHO=RMPROEOI_WHO
- +38 SET ^TMP($JOB,RMPR6641)=CDATE_U_DFN_U_WHO_U_SSN_U_TYPE_U_DES
- +39 SET ^TMP($JOB,RMPR6641)=^TMP($JOB,RMPR6641)_U_RMSTS_U_RMPRA_U_RMPR6641
- +40 ;Get Work Order Data and add to array
- +41 SET RMPRPHCI=$PIECE($GET(^RMPR(664.1,RMPR6641,2,1,0)),U,1)
- SET RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI)
- +42 SET RMPRWN=$PIECE(WO66410,U,13)
- +43 SET RMPRROFF=$$EXTERNAL^DILFD(664.1,13,"",$PIECE(WO66410,U,5))
- +44 SET RMPRTECH=$$EXTERNAL^DILFD(664.1,13,"",$PIECE(WO66410,U,16))
- +45 SET RMPRSOPI=$PIECE(WO66410,U,11)
- SET RMPRSOPE=$$EXTERNAL^DILFD(664.1,2,"",RMPRSOPI)
- +46 SET RMNPPDSI=$PIECE(WO66410,U,3)
- SET RMNPPDSE=$$EXTERNAL^DILFD(664.1,.03,"",RMNPPDSI)
- SET RMNPPDSN=$$STATN^RMPRUTIL(RMNPPDSI)
- +47 SET RMPRSITE=$ORDER(^RMPR(669.9,"C",RMNPPDSI,0))
- +48 SET RMREQSTI=$PIECE(WO66410,U,4)
- SET RMREQSTE=$$EXTERNAL^DILFD(664.1,.04,"",RMREQSTI)
- SET RMREQSTN=$$STATN^RMPRUTIL(RMREQSTI)
- +49 SET RMRECSTI=$PIECE(WO66410,U,15)
- SET RMRECSTE=$$EXTERNAL^DILFD(664.1,.11,"",RMRECSTI)
- SET RMRECSTN=$$STATN^RMPRUTIL(RMRECSTI)
- +50 SET ^TMP($JOB,RMPR6641)=^TMP($JOB,RMPR6641)_U_RMPRPHCE_U_RMPRWN_U_RMPRROFF_U_RMPRTECH_U_RMPRSOPE_U_RMNPPDSN_U_RMNPPDSE_U_RMREQSTN_U_RMREQSTE_U_RMRECSTN_U_RMRECSTE_U_RMPRSITE_U_WDATE_U_RMRDTE
- +51 KILL CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE,RMRDTE
- +52 ;PUT RESULTS IN GLOBAL!!
- +53 QUIT
- +54 KILL CDAY,CNT,DATE,DFN,I,LINKED,RMNPPDSE,RMNPPDSI,RMNPPDSN,RMPR6641
- +55 KILL RMPRPHCE,RMPRPHCI,RMPRROFF,RMPRSITE,RMPRSOPE,RMPRSOPI,RMPRTECH
- +56 KILL RMPRWN,RMPRDTI,RMRECSTE,RMRECSTI,RMRECSTN,RMREQSTE,RMREQSTI
- +57 KILL RMREQSTN,RMSTS,RMWDTI,RRX,SITE,START,STN,STNX,STOP,VALMCNT,WDATE,WO66410,WRKDAY
- EXIT ;common exit point
- +1 SET RESULT=$NAME(^TMP($JOB,"RMPRWO"))
- +2 QUIT