- RMPR145P ;VM/RB - FIX PROBLEM PCE ENCOUNTERS FROM FILE #660 ITEMS ;03/27/08
- ;;3.0;Prosthetics;**145**;13/27/08;Build 6
- ;;
- Q
- FIXPCE ;1. Post install to correct 'action required' PCE Encounters created
- ; from Prosthetic items via nightly PCE interface and edit/delete
- ; issues/orders.
- ;
- BUILD K ^XTMP("RMPR145P") D NOW^%DTC S RMSTART=%
- S ^XTMP("RMPR145P","START COMPILE")=RMSTART
- S ^XTMP("RMPR145P","END COMPILE")="RUNNING"
- S ^XTMP("RMPR145P",0)=$$FMADD^XLFDT(RMSTART,90)_"^"_RMSTART
- 0 ;FIND 660 RECORDS WITH PCE LINKS
- S IEN=0,U="^",XX=0,TOT=0
- 1 S IEN=$O(^RMPR(660,IEN)) G EXIT:IEN=""!(IEN]"@")
- S R=$G(^RMPR(660,IEN,0)),DFN=$P(R,U,2),R10=$G(^RMPR(660,IEN,10))
- ;I $E($P(R,U),1,3)<306 G 1
- G:DFN="" 1 S PNAME=$P(^DPT(DFN,0),U,1)
- I R=""!(R10="") G 1
- S VISIEN=$P(R10,U,12) I VISIEN="" G 1
- S RV=$G(^AUPNVSIT(VISIEN,0)) I RV="" G 1
- S RV8=$G(^AUPNVSIT(VISIEN,800))
- 2 ;check for required contaminants in associated encounter
- S PCEIEN=$O(^SCE("AVSIT",VISIEN,0)) I PCEIEN="" G 1
- S PCE0=$G(^SCE(PCEIEN,0)) I PCE0="" G 1
- I $P(PCE0,U,12)'=14 G 1
- EVAL ;beginning of evaluation criteria for 'action required'
- S SDOE=PCEIEN
- S SDOE0=$$GETOE^SDOE(SDOE),SDIV=$P(SDOE0,U,11)
- D DEM^VADPT M SDDPT=VADM
- K SDX D CLASK^SDCO2(PCEIEN,.SDX)
- I '$D(SDX) G 1
- S SDI=0,ERR=0,SDXX="" F S SDI=$O(SDX(SDI)) Q:'SDI I $P(SDX(SDI),U,2)="" S SDX="" D I SDX'="" S ERR=1,^XTMP("RMPR145P",660,IEN,99,SDI)=SDX(SDI)_U_SDX,SDXX=SDXX_U_SDI
- . I '$D(^SD(409.41,SDI,0)) S SDX="Classification required" S:'$D(TOT(SDI)) TOT(SDI)=0 S TOT(SDI)=TOT(SDI)+1 Q ;W !,SDX Q
- . S SDX=$P($G(^SD(409.41,SDI,0)),U,1)_" classification required" S:'$D(TOT(SDI)) TOT(SDI)=0 S TOT(SDI)=TOT(SDI)+1 ;W !,SDX
- I ERR=1 S TOT=TOT+1 D
- . S ^XTMP("RMPR145P",660,IEN,10)=R
- . S ^XTMP("RMPR145P",660,IEN,10)=R10
- . S ^XTMP("RMPR145P",660,IEN,11)=RV
- . S ^XTMP("RMPR145P",660,IEN,12)=RV8
- . S ^XTMP("RMPR145P",660,IEN,13)=PCE0
- . ;W !!,IEN,?15,PNAME,!,R,!,R10,!,VISIEN,!,RV,!,RV8,!,PCEIEN,!,PCE0,!,SDXX
- . F I=1:1:7 I $P(RV8,U,I)="" S XX=80000+I,DA=VISIEN,DR=XX_"////^S X=0",DIE="^AUPNVSIT(" D ^DIE
- . S DA=PCEIEN,DR=".12////^S X=2",DIE="^SCE(" D ^DIE
- G 1
- EXIT ;
- ;S II=0 W !
- ;F S II=$O(TOT(II)) Q:II="" D
- ;. S ENM=$P($G(^SD(409.41,II,0)),U)
- ;. W !,ENM," classification required",?50,TOT(II)
- ;W !!,"TOTAL 'ACTION REQUIRED' ENCOUNTERS CORRECTED: ",TOT
- D NOW^%DTC S RMEND=%
- M ^XTMP("RMPR145P","ERRS")=TOT
- S ^XTMP("RMPR145P","END COMPILE")=RMEND
- K RMEND,RMSTART,IEN,XX,TOT,R,R10,DFN,PCEIEN,VISIEN,PNAME,RV,RV8,PCE0,SDOE,SDOE0,SDIV,VADM,SDDPT,SDX,SDI
- K ERR,SDXX,TOT,I,DA,DR,DIE,II,ENM
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR145P 2610 printed Mar 13, 2025@21:36:35 Page 2
- RMPR145P ;VM/RB - FIX PROBLEM PCE ENCOUNTERS FROM FILE #660 ITEMS ;03/27/08
- +1 ;;3.0;Prosthetics;**145**;13/27/08;Build 6
- +2 ;;
- +3 QUIT
- FIXPCE ;1. Post install to correct 'action required' PCE Encounters created
- +1 ; from Prosthetic items via nightly PCE interface and edit/delete
- +2 ; issues/orders.
- +3 ;
- BUILD KILL ^XTMP("RMPR145P")
- DO NOW^%DTC
- SET RMSTART=%
- +1 SET ^XTMP("RMPR145P","START COMPILE")=RMSTART
- +2 SET ^XTMP("RMPR145P","END COMPILE")="RUNNING"
- +3 SET ^XTMP("RMPR145P",0)=$$FMADD^XLFDT(RMSTART,90)_"^"_RMSTART
- 0 ;FIND 660 RECORDS WITH PCE LINKS
- +1 SET IEN=0
- SET U="^"
- SET XX=0
- SET TOT=0
- 1 SET IEN=$ORDER(^RMPR(660,IEN))
- if IEN=""!(IEN]"@")
- GOTO EXIT
- +1 SET R=$GET(^RMPR(660,IEN,0))
- SET DFN=$PIECE(R,U,2)
- SET R10=$GET(^RMPR(660,IEN,10))
- +2 ;I $E($P(R,U),1,3)<306 G 1
- +3 if DFN=""
- GOTO 1
- SET PNAME=$PIECE(^DPT(DFN,0),U,1)
- +4 IF R=""!(R10="")
- GOTO 1
- +5 SET VISIEN=$PIECE(R10,U,12)
- IF VISIEN=""
- GOTO 1
- +6 SET RV=$GET(^AUPNVSIT(VISIEN,0))
- IF RV=""
- GOTO 1
- +7 SET RV8=$GET(^AUPNVSIT(VISIEN,800))
- 2 ;check for required contaminants in associated encounter
- +1 SET PCEIEN=$ORDER(^SCE("AVSIT",VISIEN,0))
- IF PCEIEN=""
- GOTO 1
- +2 SET PCE0=$GET(^SCE(PCEIEN,0))
- IF PCE0=""
- GOTO 1
- +3 IF $PIECE(PCE0,U,12)'=14
- GOTO 1
- EVAL ;beginning of evaluation criteria for 'action required'
- +1 SET SDOE=PCEIEN
- +2 SET SDOE0=$$GETOE^SDOE(SDOE)
- SET SDIV=$PIECE(SDOE0,U,11)
- +3 DO DEM^VADPT
- MERGE SDDPT=VADM
- +4 KILL SDX
- DO CLASK^SDCO2(PCEIEN,.SDX)
- +5 IF '$DATA(SDX)
- GOTO 1
- +6 SET SDI=0
- SET ERR=0
- SET SDXX=""
- FOR
- SET SDI=$ORDER(SDX(SDI))
- if 'SDI
- QUIT
- IF $PIECE(SDX(SDI),U,2)=""
- SET SDX=""
- Begin DoDot:1
- +7 ;W !,SDX Q
- IF '$DATA(^SD(409.41,SDI,0))
- SET SDX="Classification required"
- if '$DATA(TOT(SDI))
- SET TOT(SDI)=0
- SET TOT(SDI)=TOT(SDI)+1
- QUIT
- +8 ;W !,SDX
- SET SDX=$PIECE($GET(^SD(409.41,SDI,0)),U,1)_" classification required"
- if '$DATA(TOT(SDI))
- SET TOT(SDI)=0
- SET TOT(SDI)=TOT(SDI)+1
- End DoDot:1
- IF SDX'=""
- SET ERR=1
- SET ^XTMP("RMPR145P",660,IEN,99,SDI)=SDX(SDI)_U_SDX
- SET SDXX=SDXX_U_SDI
- +9 IF ERR=1
- SET TOT=TOT+1
- Begin DoDot:1
- +10 SET ^XTMP("RMPR145P",660,IEN,10)=R
- +11 SET ^XTMP("RMPR145P",660,IEN,10)=R10
- +12 SET ^XTMP("RMPR145P",660,IEN,11)=RV
- +13 SET ^XTMP("RMPR145P",660,IEN,12)=RV8
- +14 SET ^XTMP("RMPR145P",660,IEN,13)=PCE0
- +15 ;W !!,IEN,?15,PNAME,!,R,!,R10,!,VISIEN,!,RV,!,RV8,!,PCEIEN,!,PCE0,!,SDXX
- +16 FOR I=1:1:7
- IF $PIECE(RV8,U,I)=""
- SET XX=80000+I
- SET DA=VISIEN
- SET DR=XX_"////^S X=0"
- SET DIE="^AUPNVSIT("
- DO ^DIE
- +17 SET DA=PCEIEN
- SET DR=".12////^S X=2"
- SET DIE="^SCE("
- DO ^DIE
- End DoDot:1
- +18 GOTO 1
- EXIT ;
- +1 ;S II=0 W !
- +2 ;F S II=$O(TOT(II)) Q:II="" D
- +3 ;. S ENM=$P($G(^SD(409.41,II,0)),U)
- +4 ;. W !,ENM," classification required",?50,TOT(II)
- +5 ;W !!,"TOTAL 'ACTION REQUIRED' ENCOUNTERS CORRECTED: ",TOT
- +6 DO NOW^%DTC
- SET RMEND=%
- +7 MERGE ^XTMP("RMPR145P","ERRS")=TOT
- +8 SET ^XTMP("RMPR145P","END COMPILE")=RMEND
- +9 KILL RMEND,RMSTART,IEN,XX,TOT,R,R10,DFN,PCEIEN,VISIEN,PNAME,RV,RV8,PCE0,SDOE,SDOE0,SDIV,VADM,SDDPT,SDX,SDI
- +10 KILL ERR,SDXX,TOT,I,DA,DR,DIE,II,ENM
- +11 QUIT
