- SR175UTL ;BIR/SJA - SR*3*175 UTILITY ROUTINE ;12/13/10
- ;;3.0;Surgery;**175**;24 Jun 93;Build 6
- Q
- PRE ; pre-install process for SR*3*175
- ; delete data from file 136.5 and re-initialize file
- K ^SRO(136.5) S ^SRO(136.5,0)="PERIOPERATIVE OCCURRENCE CATEGORY^136.5I^^"
- Q
- POST ; add new cancellation reasons to file 135
- N SRA,SRI,SRCD,SRTXT,SRIEN,SRZ,SRA4,SRA8,SREF
- ; kill the 'AT' x-ref and rebuild it
- K ^SRF("AT") S SRZ=0
- F S SRZ=$O(^SRF(SRZ)) Q:'SRZ I $D(^SRF(SRZ,"RA")) S SRA=$G(^SRF(SRZ,"RA")),SRA4=$P(SRA,"^",4),SRA8=$P(SRA,"^",8) D
- .Q:'SRA4&'SRA8
- .S $P(^SRF(SRZ,"RA"),"^",4)=+SRA4,$P(^SRF(SRZ,"RA"),"^",8)=+SRA8,^SRF("AT",$S($G(SRA8):+SRA8,1:+SRA4),SRZ)=""
- ;
- ; inactivate the existing cancellation reasons.
- S SRZ=0 F S SRZ=$O(^SRO(135,SRZ)) Q:'SRZ!(SRZ>1000) S DIE=135,DA=SRZ,DR="10////1" D ^DIE K DA,DIE,DR
- ; kill then rebuild "B","C" x-ref:
- K ^SRO(135,"B"),^SRO(135,"C")
- F SRI=1:1 S SRX=$T(TXT+SRI) Q:SRX="" S SRCD=+$P(SRX,";;",2),SRTXT=$P($P(SRX,";;",2),"^",2) D
- .S SRIEN=1000+SRI I '$D(^SRO(135,SRIEN,0)) S ^SRO(135,SRIEN,0)=SRTXT_"^"_(SRIEN-1000)
- F SREF=".01^B","1^C" S DIK="^SRO(135,",DIK(1)=SREF D ENALL^DIK
- K DIK S ^DD(135,.01,7.5)="I $G(DIC(0))[""L"",'$D(XUMF) K X D EN^DDIOL(""File is locked. No new entries or edits are allowed."","""",""!?5,$C(7)"")"
- ; populate file 137 with FY11 excluded CPT codes
- D PEX^SR175UT0
- Q
- TXT ;
- ;;1^PATIENT ACTION (NO SHOW, ETC)
- ;;2^CHANGE IN TREATMENT, PT HEALTH
- ;;3^NO CONSENT
- ;;4^NO LIP (SURG, ANESTH, ETC)
- ;;5^NO PERIOP NURSING (OR, PACU)
- ;;6^NO BED AVAILABLE
- ;;7^NO EQUIPMENT, NOT RME, (C-ARM)
- ;;8^NO RME (SPD, IMPLANT, DEFECT)
- ;;9^OTHER
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR175UTL 1657 printed Mar 13, 2025@21:43:24 Page 2
- SR175UTL ;BIR/SJA - SR*3*175 UTILITY ROUTINE ;12/13/10
- +1 ;;3.0;Surgery;**175**;24 Jun 93;Build 6
- +2 QUIT
- PRE ; pre-install process for SR*3*175
- +1 ; delete data from file 136.5 and re-initialize file
- +2 KILL ^SRO(136.5)
- SET ^SRO(136.5,0)="PERIOPERATIVE OCCURRENCE CATEGORY^136.5I^^"
- +3 QUIT
- POST ; add new cancellation reasons to file 135
- +1 NEW SRA,SRI,SRCD,SRTXT,SRIEN,SRZ,SRA4,SRA8,SREF
- +2 ; kill the 'AT' x-ref and rebuild it
- +3 KILL ^SRF("AT")
- SET SRZ=0
- +4 FOR
- SET SRZ=$ORDER(^SRF(SRZ))
- if 'SRZ
- QUIT
- IF $DATA(^SRF(SRZ,"RA"))
- SET SRA=$GET(^SRF(SRZ,"RA"))
- SET SRA4=$PIECE(SRA,"^",4)
- SET SRA8=$PIECE(SRA,"^",8)
- Begin DoDot:1
- +5 if 'SRA4&'SRA8
- QUIT
- +6 SET $PIECE(^SRF(SRZ,"RA"),"^",4)=+SRA4
- SET $PIECE(^SRF(SRZ,"RA"),"^",8)=+SRA8
- SET ^SRF("AT",$SELECT($GET(SRA8):+SRA8,1:+SRA4),SRZ)=""
- End DoDot:1
- +7 ;
- +8 ; inactivate the existing cancellation reasons.
- +9 SET SRZ=0
- FOR
- SET SRZ=$ORDER(^SRO(135,SRZ))
- if 'SRZ!(SRZ>1000)
- QUIT
- SET DIE=135
- SET DA=SRZ
- SET DR="10////1"
- DO ^DIE
- KILL DA,DIE,DR
- +10 ; kill then rebuild "B","C" x-ref:
- +11 KILL ^SRO(135,"B"),^SRO(135,"C")
- +12 FOR SRI=1:1
- SET SRX=$TEXT(TXT+SRI)
- if SRX=""
- QUIT
- SET SRCD=+$PIECE(SRX,";;",2)
- SET SRTXT=$PIECE($PIECE(SRX,";;",2),"^",2)
- Begin DoDot:1
- +13 SET SRIEN=1000+SRI
- IF '$DATA(^SRO(135,SRIEN,0))
- SET ^SRO(135,SRIEN,0)=SRTXT_"^"_(SRIEN-1000)
- End DoDot:1
- +14 FOR SREF=".01^B","1^C"
- SET DIK="^SRO(135,"
- SET DIK(1)=SREF
- DO ENALL^DIK
- +15 KILL DIK
- SET ^DD(135,.01,7.5)="I $G(DIC(0))[""L"",'$D(XUMF) K X D EN^DDIOL(""File is locked. No new entries or edits are allowed."","""",""!?5,$C(7)"")"
- +16 ; populate file 137 with FY11 excluded CPT codes
- +17 DO PEX^SR175UT0
- +18 QUIT
- TXT ;
- +1 ;;1^PATIENT ACTION (NO SHOW, ETC)
- +2 ;;2^CHANGE IN TREATMENT, PT HEALTH
- +3 ;;3^NO CONSENT
- +4 ;;4^NO LIP (SURG, ANESTH, ETC)
- +5 ;;5^NO PERIOP NURSING (OR, PACU)
- +6 ;;6^NO BED AVAILABLE
- +7 ;;7^NO EQUIPMENT, NOT RME, (C-ARM)
- +8 ;;8^NO RME (SPD, IMPLANT, DEFECT)
- +9 ;;9^OTHER
