SDCO ;ALB/RMO - Check Out List Manager Driver; 11 FEB 1993 10:00 am
;;5.3;Scheduling;**27,132,149,193**;08/13/93
;
EN(SDOE,SDCOHDL,SDCOXQB) ; -- main entry point for SDCO CHECK OUT list manager
; Input -- SDOE, SDCOHDL and SDCOXQB [Optional]
N SDCOACT,SDEVTF,SDAPTYP
IF $P($G(^SCE(+SDOE,0)),"^",6) G ENQ ;exit if child
D EN^VALM("SDCO CHECK OUT")
ENQ ;
Q
;
HDR ; -- header code
K VALMHDR
N DFN,SDCL,SDOE0,X,VA,SDELIG,SDATA
S SDOE0=$G(^SCE(+SDOE,0)),SDCL=+$P(SDOE0,"^",4)
S DFN=+$P(SDOE0,"^",2) D PID^VADPT
I $G(SDT)'="" S SDATA=$G(^DPT(DFN,"S",SDT,0))
S SDELIG=$$ELSTAT^SDUTL2(DFN)
I $$MHCLIN^SDUTL2(SDCL),'($$COLLAT^SDUTL2(SDELIG)!$P($G(SDATA),U,11)) D
.S SDGAF=$$NEWGAF^SDUTL2(DFN),SDGAFST=$P(SDGAF,"^")
.I SDGAFST D
..S SDGAFDT=$$FMTE^XLFDT($P(SDGAF,"^",3),"5M"),SDGAFS=$P(SDGAF,"^",2),SDGAFP=$P(SDGAF,"^",4)
..S VALMHDR(3)="GAF Date: "_SDGAFDT_" GAF Score: "_SDGAFS_" New GAF Required"
S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),"^"),1,30)_" ("_VA("BID")_")"
S:SDCL VALMHDR(1)=$$SETSTR^VALM1($E("Clinic: "_$P($G(^SC(SDCL,0)),"^"),1,20),VALMHDR(1),60,80)
S VALMHDR(2)=$$SETSTR^VALM1($E($$ORG^SDCOU(+$P(SDOE0,"^",8)),1,20)_" Date/Time: "_$$LOWER^VALM1($$FTIME^VALM1(+SDOE0)),"",1,51)
S VALMHDR(2)=$$SETSTR^VALM1("Checked Out: "_$S($$COMDT^SDCOU(SDOE):"YES",1:"NO"),VALMHDR(2),60,80)
Q
;
INIT ; -- init variables and list array -- SDOE required
D BLD
Q
;
BLD ; -- build check out screen
D CLEAN^VALM10
K ^TMP("SDCOIDX")
D HDR
D EN^SDCO0("SDCO",SDOE,1,.VALMCNT)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEAN^VALM10,CLEAR^VALM1
K ^TMP("SDCOIDX"),SDCOXQB
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCO 1730 printed Oct 16, 2024@18:49:50 Page 2
SDCO ;ALB/RMO - Check Out List Manager Driver; 11 FEB 1993 10:00 am
+1 ;;5.3;Scheduling;**27,132,149,193**;08/13/93
+2 ;
EN(SDOE,SDCOHDL,SDCOXQB) ; -- main entry point for SDCO CHECK OUT list manager
+1 ; Input -- SDOE, SDCOHDL and SDCOXQB [Optional]
+2 NEW SDCOACT,SDEVTF,SDAPTYP
+3 ;exit if child
IF $PIECE($GET(^SCE(+SDOE,0)),"^",6)
GOTO ENQ
+4 DO EN^VALM("SDCO CHECK OUT")
ENQ ;
+1 QUIT
+2 ;
HDR ; -- header code
+1 KILL VALMHDR
+2 NEW DFN,SDCL,SDOE0,X,VA,SDELIG,SDATA
+3 SET SDOE0=$GET(^SCE(+SDOE,0))
SET SDCL=+$PIECE(SDOE0,"^",4)
+4 SET DFN=+$PIECE(SDOE0,"^",2)
DO PID^VADPT
+5 IF $GET(SDT)'=""
SET SDATA=$GET(^DPT(DFN,"S",SDT,0))
+6 SET SDELIG=$$ELSTAT^SDUTL2(DFN)
+7 IF $$MHCLIN^SDUTL2(SDCL)
IF '($$COLLAT^SDUTL2(SDELIG)!$PIECE($GET(SDATA),U,11))
Begin DoDot:1
+8 SET SDGAF=$$NEWGAF^SDUTL2(DFN)
SET SDGAFST=$PIECE(SDGAF,"^")
+9 IF SDGAFST
Begin DoDot:2
+10 SET SDGAFDT=$$FMTE^XLFDT($PIECE(SDGAF,"^",3),"5M")
SET SDGAFS=$PIECE(SDGAF,"^",2)
SET SDGAFP=$PIECE(SDGAF,"^",4)
+11 SET VALMHDR(3)="GAF Date: "_SDGAFDT_" GAF Score: "_SDGAFS_" New GAF Required"
End DoDot:2
End DoDot:1
+12 SET VALMHDR(1)=$EXTRACT("Patient: "_$PIECE($GET(^DPT(DFN,0)),"^"),1,30)_" ("_VA("BID")_")"
+13 if SDCL
SET VALMHDR(1)=$$SETSTR^VALM1($EXTRACT("Clinic: "_$PIECE($GET(^SC(SDCL,0)),"^"),1,20),VALMHDR(1),60,80)
+14 SET VALMHDR(2)=$$SETSTR^VALM1($EXTRACT($$ORG^SDCOU(+$PIECE(SDOE0,"^",8)),1,20)_" Date/Time: "_$$LOWER^VALM1($$FTIME^VALM1(+SDOE0)),"",1,51)
+15 SET VALMHDR(2)=$$SETSTR^VALM1("Checked Out: "_$SELECT($$COMDT^SDCOU(SDOE):"YES",1:"NO"),VALMHDR(2),60,80)
+16 QUIT
+17 ;
INIT ; -- init variables and list array -- SDOE required
+1 DO BLD
+2 QUIT
+3 ;
BLD ; -- build check out screen
+1 DO CLEAN^VALM10
+2 KILL ^TMP("SDCOIDX")
+3 DO HDR
+4 DO EN^SDCO0("SDCO",SDOE,1,.VALMCNT)
+5 QUIT
+6 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CLEAN^VALM10
DO CLEAR^VALM1
+2 KILL ^TMP("SDCOIDX"),SDCOXQB
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
