- SDCO20 ;ALB/RMO - Process One Classification - Check Out;30 DEC 1992 1:10 pm
- ;;5.3;Scheduling;**20**;Aug 13, 1993
- ;
- ONE(SDCTI,SDATA,SDOE,SDCOQUIT) ;Process One Classification
- ; Input -- SDCTI Outpatient Classification Type IEN
- ; SDATA Null or 409.42 IEN^Internal Value^1=n/a^1=unedt
- ; SDOE Outpatient Encounter file IEN
- ; Output -- SDCOQUIT User entered '^' or timeout
- N SDCT0,SDVAL
- S SDCT0=$G(^SD(409.41,SDCTI,0)) G ONEQ:SDCT0']""
- I SDATA,$P(SDATA,"^",3) D G ONEQ
- .W !,*7,">>> ",$P(SDCT0,"^",6)," is no longer applicable..."
- .S DA=+SDATA,DIK="^SDD(409.42," D ^DIK
- .W "deleted."
- I SDATA,$P(SDATA,"^",4) D G ONEQ
- .W !,$P(SDCT0,"^",6),": ",$$VAL^SDCODD(SDCTI,$P(SDATA,"^",2))," <Uneditable>"
- S SDVAL=$$VAL(SDCTI,SDCT0,SDATA)
- I SDVAL="^" S SDCOQUIT="" D G ONEQ
- .I $P(SDCT0,"^",5),$P(SDATA,"^",2)="",$P($G(^SCE(SDOE,0)),"^",7) D COMDT^SDCODEL(SDOE,1)
- D FILE(+SDATA,SDVAL)
- ONEQ Q
- ;
- VAL(SDCTI,SDCT0,SDATA) ;Get Outpatient Classification
- N DIR,Y
- I SDCTI=3,$P($G(^SCE(+SDOE,0)),"^",10)=2 D G VALQ
- .S Y=1
- .W !,">>> Updating treatment for SC condition to 'Yes'..."
- REASK S DIR("A")=$S($P(SDCT0,"^",2)]"":$P(SDCT0,"^",2),1:$P(SDCT0,"^"))
- I $P(SDATA,"^",2)]""!($P(SDCT0,"^",4)]"") S DIR("B")=$S($P(SDATA,"^",2)]"":$$VAL^SDCODD(SDCTI,$P(SDATA,"^",2)),1:$P(SDCT0,"^",4))
- S DIR(0)=$P(SDCT0,"^",3)_"O"
- I $D(^SD(409.41,SDCTI,2)) S DIR(0)=DIR(0)_"^"_^(2)
- I SDCTI=3 S DIR("?")="^D SC^SDCO23(DFN)"
- D ^DIR
- I $P(SDCT0,"^",5),'$D(DTOUT),$P(SDATA,"^",2)="",Y=""!(Y["^"&('$P($G(^DG(43,1,"SCLR")),"^",24))) D G REASK
- .W !,*7,"This is a required response." W:Y["^" " An '^' is not allowed."
- .K DIRUT,DUOUT
- I $D(DIRUT) S Y="^"
- VALQ K DIRUT,DTOUT,DUOUT
- Q $G(Y)
- ;
- FILE(SDCNI,SDCNV) ;File Outpatient Classification
- ; Input -- SDCNI Outpatient Classification IEN
- ; SDCNV Outpatient Classification Value
- ; Output -- File Outpatient Classification
- N DA,DIE,DR,X
- I $G(SDCNI)'>0 S SDCNI=$$NEW(SDCTI,SDOE) G FILEQ:SDCNI<0
- S DA=SDCNI,DIE="^SDD(409.42,",DR=".03////^S X=SDCNV" D ^DIE
- FILEQ Q
- ;
- NEW(SDCTI,SDOE) ;Add a New Outpatient Classification
- ; Input -- SDCTI Appointment Outpatient Type file IEN
- ; SDOE Outpatient Encounter file IEN
- ; Output -- Outpatient Classification file IEN
- N DA,DD,DIC,DIK,DINUM,DLAYGO,DO,SDCNI,X,Y
- S X=SDCTI,(DIC,DIK)="^SDD(409.42,",DIC(0)="L",DLAYGO=409.42
- D FILE^DICN S SDCNI=+Y
- I SDCNI>0 L +^SDD(409.42,SDCNI) S $P(^SDD(409.42,SDCNI,0),"^",2)=SDOE,DA=SDCNI D IX1^DIK L -^SDD(409.42,SDCNI)
- NEWQ Q SDCNI
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCO20 2574 printed Feb 19, 2025@00:15:45 Page 2
- SDCO20 ;ALB/RMO - Process One Classification - Check Out;30 DEC 1992 1:10 pm
- +1 ;;5.3;Scheduling;**20**;Aug 13, 1993
- +2 ;
- ONE(SDCTI,SDATA,SDOE,SDCOQUIT) ;Process One Classification
- +1 ; Input -- SDCTI Outpatient Classification Type IEN
- +2 ; SDATA Null or 409.42 IEN^Internal Value^1=n/a^1=unedt
- +3 ; SDOE Outpatient Encounter file IEN
- +4 ; Output -- SDCOQUIT User entered '^' or timeout
- +5 NEW SDCT0,SDVAL
- +6 SET SDCT0=$GET(^SD(409.41,SDCTI,0))
- if SDCT0']""
- GOTO ONEQ
- +7 IF SDATA
- IF $PIECE(SDATA,"^",3)
- Begin DoDot:1
- +8 WRITE !,*7,">>> ",$PIECE(SDCT0,"^",6)," is no longer applicable..."
- +9 SET DA=+SDATA
- SET DIK="^SDD(409.42,"
- DO ^DIK
- +10 WRITE "deleted."
- End DoDot:1
- GOTO ONEQ
- +11 IF SDATA
- IF $PIECE(SDATA,"^",4)
- Begin DoDot:1
- +12 WRITE !,$PIECE(SDCT0,"^",6),": ",$$VAL^SDCODD(SDCTI,$PIECE(SDATA,"^",2))," <Uneditable>"
- End DoDot:1
- GOTO ONEQ
- +13 SET SDVAL=$$VAL(SDCTI,SDCT0,SDATA)
- +14 IF SDVAL="^"
- SET SDCOQUIT=""
- Begin DoDot:1
- +15 IF $PIECE(SDCT0,"^",5)
- IF $PIECE(SDATA,"^",2)=""
- IF $PIECE($GET(^SCE(SDOE,0)),"^",7)
- DO COMDT^SDCODEL(SDOE,1)
- End DoDot:1
- GOTO ONEQ
- +16 DO FILE(+SDATA,SDVAL)
- ONEQ QUIT
- +1 ;
- VAL(SDCTI,SDCT0,SDATA) ;Get Outpatient Classification
- +1 NEW DIR,Y
- +2 IF SDCTI=3
- IF $PIECE($GET(^SCE(+SDOE,0)),"^",10)=2
- Begin DoDot:1
- +3 SET Y=1
- +4 WRITE !,">>> Updating treatment for SC condition to 'Yes'..."
- End DoDot:1
- GOTO VALQ
- REASK SET DIR("A")=$SELECT($PIECE(SDCT0,"^",2)]"":$PIECE(SDCT0,"^",2),1:$PIECE(SDCT0,"^"))
- +1 IF $PIECE(SDATA,"^",2)]""!($PIECE(SDCT0,"^",4)]"")
- SET DIR("B")=$SELECT($PIECE(SDATA,"^",2)]"":$$VAL^SDCODD(SDCTI,$PIECE(SDATA,"^",2)),1:$PIECE(SDCT0,"^",4))
- +2 SET DIR(0)=$PIECE(SDCT0,"^",3)_"O"
- +3 IF $DATA(^SD(409.41,SDCTI,2))
- SET DIR(0)=DIR(0)_"^"_^(2)
- +4 IF SDCTI=3
- SET DIR("?")="^D SC^SDCO23(DFN)"
- +5 DO ^DIR
- +6 IF $PIECE(SDCT0,"^",5)
- IF '$DATA(DTOUT)
- IF $PIECE(SDATA,"^",2)=""
- IF Y=""!(Y["^"&('$PIECE($GET(^DG(43,1,"SCLR")),"^",24)))
- Begin DoDot:1
- +7 WRITE !,*7,"This is a required response."
- if Y["^"
- WRITE " An '^' is not allowed."
- +8 KILL DIRUT,DUOUT
- End DoDot:1
- GOTO REASK
- +9 IF $DATA(DIRUT)
- SET Y="^"
- VALQ KILL DIRUT,DTOUT,DUOUT
- +1 QUIT $GET(Y)
- +2 ;
- FILE(SDCNI,SDCNV) ;File Outpatient Classification
- +1 ; Input -- SDCNI Outpatient Classification IEN
- +2 ; SDCNV Outpatient Classification Value
- +3 ; Output -- File Outpatient Classification
- +4 NEW DA,DIE,DR,X
- +5 IF $GET(SDCNI)'>0
- SET SDCNI=$$NEW(SDCTI,SDOE)
- if SDCNI<0
- GOTO FILEQ
- +6 SET DA=SDCNI
- SET DIE="^SDD(409.42,"
- SET DR=".03////^S X=SDCNV"
- DO ^DIE
- FILEQ QUIT
- +1 ;
- NEW(SDCTI,SDOE) ;Add a New Outpatient Classification
- +1 ; Input -- SDCTI Appointment Outpatient Type file IEN
- +2 ; SDOE Outpatient Encounter file IEN
- +3 ; Output -- Outpatient Classification file IEN
- +4 NEW DA,DD,DIC,DIK,DINUM,DLAYGO,DO,SDCNI,X,Y
- +5 SET X=SDCTI
- SET (DIC,DIK)="^SDD(409.42,"
- SET DIC(0)="L"
- SET DLAYGO=409.42
- +6 DO FILE^DICN
- SET SDCNI=+Y
- +7 IF SDCNI>0
- LOCK +^SDD(409.42,SDCNI)
- SET $PIECE(^SDD(409.42,SDCNI,0),"^",2)=SDOE
- SET DA=SDCNI
- DO IX1^DIK
- LOCK -^SDD(409.42,SDCNI)
- NEWQ QUIT SDCNI