- ORCSLT ;ABV/MKN - IF ADMIN OR DS CONSULT SERVICE, AUTO-SIGN;05/23/2018 10:00 AM
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**490**;July 18, 2018;Build 21
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- CHKAUTO ;
- N DA,DIE,DR,ORDITM,ORDNA,ORDO,ORDS
- Q:'$D(^XUSEC("OR ADMIN RBP TO CC",DUZ))
- S ORDITM=$G(ORDIALOG(4,1)) Q:'ORDITM
- S ORDNA=$$GET1^DIQ(101.43,ORDITM_",",.01,"E")
- Q:'(ORDNA["COMMUNITY CARE"&(ORDNA["-ADMIN"!(ORDNA["-DS")))
- D VALID^ORWDXA(.ORDO,ORIFN,"OC",DUZ) ;Signature on chart
- S ORDS(1)=ORIFN_";1^1^1^E"
- K ORDO D SEND^ORWDX(.ORDO,ORVP,ORNP,ORL," ",.ORDS)
- S DA(1)=ORIFN,DA=1,DIE="^OR(100,"_ORIFN_",8,"
- S DR="4///1;1///ADMINISTRATIVELY RELEASED BY POLICY;7///@;80///Y"
- D ^DIE
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCSLT 729 printed Feb 18, 2025@23:55:39 Page 2
- ORCSLT ;ABV/MKN - IF ADMIN OR DS CONSULT SERVICE, AUTO-SIGN;05/23/2018 10:00 AM
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**490**;July 18, 2018;Build 21
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- CHKAUTO ;
- +1 NEW DA,DIE,DR,ORDITM,ORDNA,ORDO,ORDS
- +2 if '$DATA(^XUSEC("OR ADMIN RBP TO CC",DUZ))
- QUIT
- +3 SET ORDITM=$GET(ORDIALOG(4,1))
- if 'ORDITM
- QUIT
- +4 SET ORDNA=$$GET1^DIQ(101.43,ORDITM_",",.01,"E")
- +5 if '(ORDNA["COMMUNITY CARE"&(ORDNA["-ADMIN"!(ORDNA["-DS")))
- QUIT
- +6 ;Signature on chart
- DO VALID^ORWDXA(.ORDO,ORIFN,"OC",DUZ)
- +7 SET ORDS(1)=ORIFN_";1^1^1^E"
- +8 KILL ORDO
- DO SEND^ORWDX(.ORDO,ORVP,ORNP,ORL," ",.ORDS)
- +9 SET DA(1)=ORIFN
- SET DA=1
- SET DIE="^OR(100,"_ORIFN_",8,"
- +10 SET DR="4///1;1///ADMINISTRATIVELY RELEASED BY POLICY;7///@;80///Y"
- +11 DO ^DIE
- +12 QUIT
- +13 ;