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 Nov 22, 2024@17:48:11 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
