- APSPCTR ; IHS/DSD/ENM/BAO/DMH/CIA/PLS - CONTROLLED DRUG LIST BY DIV;10-Nov-2011 13:16;PLS
- ;;7.0;IHS PHARMACY MODIFICATIONS;**1004,1006,1008,1009,1013**;Sep 23, 2004;Build 33
- ; Modified - IHS/CIA/PLS - 01/13/04 - Updated version
- ; Modified - IHS/CIA/PLS - 02/24/06 - Patch 1004
- ; Modified - IHS/MSC/PLS - 09/26/07 - Patch 1006 - Added CHKSTAT check and business rule for DE date=Fill date for exclusion
- ; IHS/MSC/PLS - 12/30/08 - Patch 1008 - Routine updated
- ; - 08/31/09 - Patch 1008 - Added DSPRDT for release date check
- ; - 12/14/09 - Patch 1009 - removed check for $$DIVVRY in the inital loop of Find.
- ; - 11/10/11 - Patch 1013 - TallMan support
- EN ;EP
- N APSP,APSPAT,APSPATN,APSPBD,APSPCHN,APSPD,APSPDES,APSPDR,APSPBD,APSPED,APSPX,APSPN,APSPRX,APSPSH,DIC,APSPANS,APSPDTDR
- N APSPDRUG,APSPED,APSPGO,APSPITM,APSPMD,APSPMSG,APSPOP,APSPQTY,APSPRN,APSPRXN,APSPZZ,APSPBD,APSPCLER,APSPDIV,APSPDV
- N APSPGT,APSPT,APSPC9,%ZIS,%DT,POP,APSPQ,APSPBDF,APSPEDF
- W @IOF,!!,"Pharmacy Controlled Drug List by Division"
- W !,*7,?10,"132 Character Format!",!
- D ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
- Q:APSPQ
- S APSPBDF=$P($TR($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
- S APSPEDF=$P($TR($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
- S APSPBD=APSPBD-.01,APSPED=APSPED+.99
- ;SELECT DIVISION
- S APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
- Q:APSPQ
- I APSPDIV D
- .S APSPDIV="*"
- E D Q:APSPQ
- .S APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
- Q:APSPQ
- S APSPDTDR=$$DIR^APSPUTIL("S^1:Date;2:Drug","Sort Report by",,,.APSPQ)
- Q:APSPQ
- D Q:APSPQ
- .S APSPDCLS=$$DIR^APSPUTIL("S^1:C-2'S;2:C-3'S to C5'S;3:All","Drug Class Types","",,.APSPQ)
- .S APSPDCT(1)="2",APSPDCT(3)="2345",APSPDCT(2)="345"
- .S APSPDCTN(1)="C-II",APSPDCTN(2)="C-III through C-V",APSPDCTN(3)="C-II through C-V"
- D DEV
- Q
- DEV ;
- N XBRP,XBNS
- S XBRP="OUT^APSPCTR"
- S XBNS="APS*"
- D ^XBDBQUE
- Q
- OUT ;EP
- U IO
- K ^TMP($J)
- D FIND(APSPBD,APSPED,"AD",$G(APSPDCLS)) ; Regular and Refill
- D FIND(APSPBD,APSPED,"ADP",$G(APSPDCLS)) ; Partial
- D PRINT^APSPCTR1
- K ^TMP($J)
- Q
- ;
- FIND(SDT,EDT,XREF,DCLS) ;EP
- N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN
- S FDTLP=SDT-.01
- F S FDTLP=$O(^PSRX(XREF,FDTLP)) Q:'FDTLP!(FDTLP>EDT) D
- .S RXIEN=0
- .F S RXIEN=$O(^PSRX(XREF,FDTLP,RXIEN)) Q:'RXIEN D
- ..Q:$$CHKSTAT(RXIEN) ; check prescription status
- ..;Q:'$$DIVVRY(RXIEN,APSPDIV) ;check division ;Patch 1009 commented out
- ..Q:'$P(^PSRX(RXIEN,0),U,6) ; Prescription must have a drug
- ..Q:'$$DCVRY(APSPDCLS,RXIEN) ;Quit if Drug Class search and drug doesn't match class
- ..S IEN="" F S IEN=$O(^PSRX(XREF,FDTLP,RXIEN,IEN)) Q:IEN="" D
- ...Q:'IEN&($$GET1^DIQ(52,RXIEN,32.1,"I")) ; Quit if original fill and a return to stock date exists
- ...Q:'$$DIVVRY(RXIEN,APSPDIV,XREF,IEN) ;check division
- ...Q:'$$DSPRDT(RXIEN,XREF,IEN) ;check for release date
- ...D SET(FDTLP,RXIEN,XREF,IEN)
- Q
- ; Check status business rules
- ; Input: RX - Prescription IEN
- ; Output: 0 - Prescription status OK, 1- Failed check
- CHKSTAT(RX) ; EP
- N STA
- S STA=$P($G(^PSRX(RX,"STA")),U)
- Q:STA=13 1 ;Deleted
- ;Q:STA=5 1 ;Suspended
- ; Discontinue/Edit Status and (Fill Date = Order D/C Date) per PSG
- I STA=15,$$GET1^DIQ(52,RX,22,"I")=$P($$GET1^DIQ(100,$$GET1^DIQ(52,RX,39.3,"I"),63,"I"),".") Q 1
- Q 0
- ; Return boolean flag indicating prescription drug matches selected report drug class
- ; Input: DCLS - Drug Class based on input selected by user
- ; RX - Prescription IEN
- DCVRY(DCLS,RX) ;EP
- N RXRTSDT,DRGIEN,DCLSVAL
- S RXRTSDT=$P($G(^PSRX(RXIEN,2)),U,15)
- S DRGIEN=$P(^PSRX(RX,0),U,6)
- Q:'$D(^PSDRUG(DRGIEN,0)) ; Check for missing drug entry
- S DCLSVAL=$P(^PSDRUG(DRGIEN,0),U,3)
- Q APSPDCT(DCLS)[+DCLSVAL
- ; Return boolean flag indicating valid pharmacy division
- DIVVRY(RX,DIV,TYP,SIEN) ;EP
- Q:DIV="*" 1
- Q $S($G(SIEN):DIV=+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,9),1:DIV=+$P(^PSRX(RX,2),U,9))
- ; Return release date for dispense
- DSPRDT(RX,TYP,SIEN) ;EP
- Q $S($G(SIEN):+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,$S(TYP="ADP":19,1:18)),1:+$P(^PSRX(RX,2),U,13))
- ; Set data into ^TMP global for output
- SET(FDT,RX,XREF,SIEN) ;EP
- N LSTDSPDT,NODE0,NODE2,NODE3,DIV,DCLS,RTSDATE,DRUG,RDT,RIFLG,FTYPE
- N PNM,DFN,DAYS,OPRV,PHRM,QTY,OPRVNM,CLERK,EDCLS,NXT
- S FTYPE=$S(XREF="ADP":"P",SIEN:"R",1:"F")
- S NXT=$O(^TMP($J,"DATA",$C(1)),-1)
- S NXT=NXT+1
- S NODE0=^PSRX(RX,0)
- S NODE2=^PSRX(RX,2)
- S NODE3=^PSRX(RX,3)
- S DRUG=$P(NODE0,U,6)
- S DFN=$P(NODE0,U,2)
- S PNM=$$GET1^DIQ(2,DFN,.01)
- S DRGNM=$P(^PSDRUG(DRUG,0),U)
- S DCLS=+$P(^PSDRUG(DRUG,0),U,3)
- S EDCLS=$$CVTDCLS(DCLS)
- S LSTDSPDT=+NODE3
- S RIFLG=""
- S DIV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.09,FTYPE="R":8,1:20),"I") ; Pharmacy Division IEN
- S RDT=$$GET1^DIQ(52,RX,31,"I") ;Release Date
- S QTY=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.04,FTYPE="R":1,1:7))
- S DAYS=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.041,FTYPE="R":1.1,1:8))
- S OPRV=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":6,FTYPE="R":15,1:4),"I")
- S OPRVNM=$$GET1^DIQ(200,OPRV,.01)
- S CLERK=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.07,FTYPE="R":6,1:16),"I")
- S:'$L(OPRVNM) OPRVNM="NONAME"
- S PHRM=$$GET1^DIQ($S(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$S("PR"[FTYPE:SIEN_","_RX_",",1:RX),$S(FTYPE="P":.05,FTYPE="R":4,1:23),"I")
- ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
- ;Format: Prescription IEN^Fill Date^Xref ("AD" or "ADP")^Fill SubIEN^Prescription Number^QTY^Drug Class^Drug Name^Fill Type^RI Flg^Drug IEN^RX Division^Days Supply^Prescriber^Pharmacist^Clerk
- S ^TMP($J,"DATA",NXT)=RXIEN_U_FDT_U_XREF_U_SIEN_U_$P(NODE0,U)_U_QTY_U_EDCLS_U_DRGNM_U_FTYPE_U_RIFLG_U_DRUG_U_DIV_U_DAYS_U_OPRV_U_PHRM_U_CLERK
- S DRGNM=$$UP^XLFSTR(DRGNM) ;1013
- S ^TMP($J,"XREF",DIV,"FDT",FDT,DCLS,DRGNM,NXT)=""
- S ^TMP($J,"XREF",DIV,"DRUG",DRGNM,DCLS,FDT,NXT)=""
- S ^TMP($J,"XREF","RX",RX,FTYPE,SIEN)=NXT
- Q
- ;
- CVTDCLS(DCLS) ; EP
- Q:DCLS=2 "C-II"
- Q:DCLS=3 "C-III"
- Q:DCLS=4 "C-IV"
- Q:DCLS=5 "C-V"
- Q "C-UNKNOWN"
- APSPCTR ; IHS/DSD/ENM/BAO/DMH/CIA/PLS - CONTROLLED DRUG LIST BY DIV;10-Nov-2011 13:16;PLS
- +1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1004,1006,1008,1009,1013**;Sep 23, 2004;Build 33
- +2 ; Modified - IHS/CIA/PLS - 01/13/04 - Updated version
- +3 ; Modified - IHS/CIA/PLS - 02/24/06 - Patch 1004
- +4 ; Modified - IHS/MSC/PLS - 09/26/07 - Patch 1006 - Added CHKSTAT check and business rule for DE date=Fill date for exclusion
- +5 ; IHS/MSC/PLS - 12/30/08 - Patch 1008 - Routine updated
- +6 ; - 08/31/09 - Patch 1008 - Added DSPRDT for release date check
- +7 ; - 12/14/09 - Patch 1009 - removed check for $$DIVVRY in the inital loop of Find.
- +8 ; - 11/10/11 - Patch 1013 - TallMan support
- EN ;EP
- +1 NEW APSP,APSPAT,APSPATN,APSPBD,APSPCHN,APSPD,APSPDES,APSPDR,APSPBD,APSPED,APSPX,APSPN,APSPRX,APSPSH,DIC,APSPANS,APSPDTDR
- +2 NEW APSPDRUG,APSPED,APSPGO,APSPITM,APSPMD,APSPMSG,APSPOP,APSPQTY,APSPRN,APSPRXN,APSPZZ,APSPBD,APSPCLER,APSPDIV,APSPDV
- +3 NEW APSPGT,APSPT,APSPC9,%ZIS,%DT,POP,APSPQ,APSPBDF,APSPEDF
- +4 WRITE @IOF,!!,"Pharmacy Controlled Drug List by Division"
- +5 WRITE !,*7,?10,"132 Character Format!",!
- +6 DO ASKDATES^APSPUTIL(.APSPBD,.APSPED,.APSPQ,DT,DT)
- +7 IF APSPQ
- QUIT
- +8 SET APSPBDF=$PIECE($TRANSLATE($$FMTE^XLFDT(APSPBD,"5Z"),"@"," "),":",1,2)
- +9 SET APSPEDF=$PIECE($TRANSLATE($$FMTE^XLFDT(APSPED,"5Z"),"@"," "),":",1,2)
- +10 SET APSPBD=APSPBD-.01
- SET APSPED=APSPED+.99
- +11 ;SELECT DIVISION
- +12 SET APSPDIV=$$DIR^APSPUTIL("Y","Would you like all pharmacy divisions","Yes",,.APSPQ)
- +13 IF APSPQ
- QUIT
- +14 IF APSPDIV
- Begin DoDot:1
- +15 SET APSPDIV="*"
- End DoDot:1
- +16 IF '$TEST
- Begin DoDot:1
- +17 SET APSPDIV=$$GETIEN^APSPUTIL(59,"Select Pharmacy Division: ",.APSPQ)
- End DoDot:1
- IF APSPQ
- QUIT
- +18 IF APSPQ
- QUIT
- +19 SET APSPDTDR=$$DIR^APSPUTIL("S^1:Date;2:Drug","Sort Report by",,,.APSPQ)
- +20 IF APSPQ
- QUIT
- +21 Begin DoDot:1
- +22 SET APSPDCLS=$$DIR^APSPUTIL("S^1:C-2'S;2:C-3'S to C5'S;3:All","Drug Class Types","",,.APSPQ)
- +23 SET APSPDCT(1)="2"
- SET APSPDCT(3)="2345"
- SET APSPDCT(2)="345"
- +24 SET APSPDCTN(1)="C-II"
- SET APSPDCTN(2)="C-III through C-V"
- SET APSPDCTN(3)="C-II through C-V"
- End DoDot:1
- IF APSPQ
- QUIT
- +25 DO DEV
- +26 QUIT
- DEV ;
- +1 NEW XBRP,XBNS
- +2 SET XBRP="OUT^APSPCTR"
- +3 SET XBNS="APS*"
- +4 DO ^XBDBQUE
- +5 QUIT
- OUT ;EP
- +1 USE IO
- +2 KILL ^TMP($JOB)
- +3 ; Regular and Refill
- DO FIND(APSPBD,APSPED,"AD",$GET(APSPDCLS))
- +4 ; Partial
- DO FIND(APSPBD,APSPED,"ADP",$GET(APSPDCLS))
- +5 DO PRINT^APSPCTR1
- +6 KILL ^TMP($JOB)
- +7 QUIT
- +8 ;
- FIND(SDT,EDT,XREF,DCLS) ;EP
- +1 NEW RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN
- +2 SET FDTLP=SDT-.01
- +3 FOR
- SET FDTLP=$ORDER(^PSRX(XREF,FDTLP))
- IF 'FDTLP!(FDTLP>EDT)
- QUIT
- Begin DoDot:1
- +4 SET RXIEN=0
- +5 FOR
- SET RXIEN=$ORDER(^PSRX(XREF,FDTLP,RXIEN))
- IF 'RXIEN
- QUIT
- Begin DoDot:2
- +6 ; check prescription status
- IF $$CHKSTAT(RXIEN)
- QUIT
- +7 ;Q:'$$DIVVRY(RXIEN,APSPDIV) ;check division ;Patch 1009 commented out
- +8 ; Prescription must have a drug
- IF '$PIECE(^PSRX(RXIEN,0),U,6)
- QUIT
- +9 ;Quit if Drug Class search and drug doesn't match class
- IF '$$DCVRY(APSPDCLS,RXIEN)
- QUIT
- +10 SET IEN=""
- FOR
- SET IEN=$ORDER(^PSRX(XREF,FDTLP,RXIEN,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:3
- +11 ; Quit if original fill and a return to stock date exists
- IF 'IEN&($$GET1^DIQ(52,RXIEN,32.1,"I"))
- QUIT
- +12 ;check division
- IF '$$DIVVRY(RXIEN,APSPDIV,XREF,IEN)
- QUIT
- +13 ;check for release date
- IF '$$DSPRDT(RXIEN,XREF,IEN)
- QUIT
- +14 DO SET(FDTLP,RXIEN,XREF,IEN)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 QUIT
- +16 ; Check status business rules
- +17 ; Input: RX - Prescription IEN
- +18 ; Output: 0 - Prescription status OK, 1- Failed check
- CHKSTAT(RX) ; EP
- +1 NEW STA
- +2 SET STA=$PIECE($GET(^PSRX(RX,"STA")),U)
- +3 ;Deleted
- IF STA=13
- QUIT 1
- +4 ;Q:STA=5 1 ;Suspended
- +5 ; Discontinue/Edit Status and (Fill Date = Order D/C Date) per PSG
- +6 IF STA=15
- IF $$GET1^DIQ(52,RX,22,"I")=$PIECE($$GET1^DIQ(100,$$GET1^DIQ(52,RX,39.3,"I"),63,"I"),".")
- QUIT 1
- +7 QUIT 0
- +8 ; Return boolean flag indicating prescription drug matches selected report drug class
- +9 ; Input: DCLS - Drug Class based on input selected by user
- +10 ; RX - Prescription IEN
- DCVRY(DCLS,RX) ;EP
- +1 NEW RXRTSDT,DRGIEN,DCLSVAL
- +2 SET RXRTSDT=$PIECE($GET(^PSRX(RXIEN,2)),U,15)
- +3 SET DRGIEN=$PIECE(^PSRX(RX,0),U,6)
- +4 ; Check for missing drug entry
- IF '$DATA(^PSDRUG(DRGIEN,0))
- QUIT
- +5 SET DCLSVAL=$PIECE(^PSDRUG(DRGIEN,0),U,3)
- +6 QUIT APSPDCT(DCLS)[+DCLSVAL
- +7 ; Return boolean flag indicating valid pharmacy division
- DIVVRY(RX,DIV,TYP,SIEN) ;EP
- +1 IF DIV="*"
- QUIT 1
- +2 QUIT $SELECT($GET(SIEN):DIV=+$PIECE($GET(^PSRX(RX,$SELECT(TYP="ADP":"P",1:1),SIEN,0)),U,9),1:DIV=+$PIECE(^PSRX(RX,2),U,9))
- +3 ; Return release date for dispense
- DSPRDT(RX,TYP,SIEN) ;EP
- +1 QUIT $SELECT($GET(SIEN):+$PIECE($GET(^PSRX(RX,$SELECT(TYP="ADP":"P",1:1),SIEN,0)),U,$SELECT(TYP="ADP":19,1:18)),1:+$PIECE(^PSRX(RX,2),U,13))
- +2 ; Set data into ^TMP global for output
- SET(FDT,RX,XREF,SIEN) ;EP
- +1 NEW LSTDSPDT,NODE0,NODE2,NODE3,DIV,DCLS,RTSDATE,DRUG,RDT,RIFLG,FTYPE
- +2 NEW PNM,DFN,DAYS,OPRV,PHRM,QTY,OPRVNM,CLERK,EDCLS,NXT
- +3 SET FTYPE=$SELECT(XREF="ADP":"P",SIEN:"R",1:"F")
- +4 SET NXT=$ORDER(^TMP($JOB,"DATA",$CHAR(1)),-1)
- +5 SET NXT=NXT+1
- +6 SET NODE0=^PSRX(RX,0)
- +7 SET NODE2=^PSRX(RX,2)
- +8 SET NODE3=^PSRX(RX,3)
- +9 SET DRUG=$PIECE(NODE0,U,6)
- +10 SET DFN=$PIECE(NODE0,U,2)
- +11 SET PNM=$$GET1^DIQ(2,DFN,.01)
- +12 SET DRGNM=$PIECE(^PSDRUG(DRUG,0),U)
- +13 SET DCLS=+$PIECE(^PSDRUG(DRUG,0),U,3)
- +14 SET EDCLS=$$CVTDCLS(DCLS)
- +15 SET LSTDSPDT=+NODE3
- +16 SET RIFLG=""
- +17 ; Pharmacy Division IEN
- SET DIV=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":.09,FTYPE="R":8,1:20),"I")
- +18 ;Release Date
- SET RDT=$$GET1^DIQ(52,RX,31,"I")
- +19 SET QTY=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":.04,FTYPE="R":1,1:7))
- +20 SET DAYS=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":.041,FTYPE="R":1.1,1:8))
- +21 SET OPRV=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":6,FTYPE="R":15,1:4),"I")
- +22 SET OPRVNM=$$GET1^DIQ(200,OPRV,.01)
- +23 SET CLERK=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":.07,FTYPE="R":6,1:16),"I")
- +24 IF '$LENGTH(OPRVNM)
- SET OPRVNM="NONAME"
- +25 SET PHRM=$$GET1^DIQ($SELECT(FTYPE="P":52.2,FTYPE="R":52.1,1:52),$SELECT("PR"[FTYPE:SIEN_","_RX_",",1:RX),$SELECT(FTYPE="P":.05,FTYPE="R":4,1:23),"I")
- +26 ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
- +27 ;Format: Prescription IEN^Fill Date^Xref ("AD" or "ADP")^Fill SubIEN^Prescription Number^QTY^Drug Class^Drug Name^Fill Type^RI Flg^Drug IEN^RX Division^Days Supply^Prescriber^Pharmacist^Clerk
- +28 SET ^TMP($JOB,"DATA",NXT)=RXIEN_U_FDT_U_XREF_U_SIEN_U_$PIECE(NODE0,U)_U_QTY_U_EDCLS_U_DRGNM_U_FTYPE_U_RIFLG_U_DRUG_U_DIV_U_DAYS_U_OPRV_U_PHRM_U_CLERK
- +29 ;1013
- SET DRGNM=$$UP^XLFSTR(DRGNM)
- +30 SET ^TMP($JOB,"XREF",DIV,"FDT",FDT,DCLS,DRGNM,NXT)=""
- +31 SET ^TMP($JOB,"XREF",DIV,"DRUG",DRGNM,DCLS,FDT,NXT)=""
- +32 SET ^TMP($JOB,"XREF","RX",RX,FTYPE,SIEN)=NXT
- +33 QUIT
- +34 ;
- CVTDCLS(DCLS) ; EP
- +1 IF DCLS=2
- QUIT "C-II"
- +2 IF DCLS=3
- QUIT "C-III"
- +3 IF DCLS=4
- QUIT "C-IV"
- +4 IF DCLS=5
- QUIT "C-V"
- +5 QUIT "C-UNKNOWN"