- SCCVDSP ; ALB/TMP - SCHED VSTS CONVERT/ARCHIVE - TEMPLATE LISTS ; 25-NOV-97
- ;;5.3;Scheduling;**211**;Aug 13, 1993
- ;
- BLD(SCCVTYP) ; -- build list of template entries
- ; SCCVTYP = 'AST or 'CST' for type of template
- ;
- K ^TMP("SCCV."_SCCVTYP,$J),^TMP("SCCV."_SCCVTYP_".DX",$J)
- N SCCVFL,SCCVFIL,SCCVTMP,SCCV0,SCCV1,SCCVCT,SCCVDT,SCCVLDT,SCCVGAP,SCCVX
- N SCCV1ST,SCCVCAN
- S (SCCVCT,VALMCNT)=0,SCCVSCRN=1
- S SCCVFIL=$S(SCCVTYP="CST":404.98,1:404.99)
- S SCCVCAN=+$P($G(^SD(404.91,1,"CNV")),U,9)
- ;
- ; -- find all templates
- S SCCVFL="^SD("_SCCVFIL_")"
- ;
- S SCCV1ST=1
- S SCCVGAP=" "
- S SCCVDT=0,SCCVLDT=+$G(^SD(404.91,1,"CNV"))
- ;
- F S SCCVDT=$O(@SCCVFL@("C",SCCVDT)) Q:'SCCVDT D
- . S SCCVTMP=0 F S SCCVTMP=$O(@SCCVFL@("C",SCCVDT,SCCVTMP)) Q:'SCCVTMP S SCCV0=$G(@SCCVFL@(SCCVTMP,0)),SCCV1=$G(^(1)) D
- . . ; if cancelled and should be listed ... list last
- . . I $P(SCCV0,U,9) S:SCCVCAN SCCVX(SCCVDT,SCCVTMP)="" Q
- . . ;
- . . ; -- Check for gaps
- . . I 'SCCV1ST D ;Chk for date gaps between templates
- . . . S SCCVGAP=$S($$FMADD^XLFDT(SCCVLDT,1)=SCCVDT:" ",1:"*")
- . . . S SCCVLDT=$P(SCCV0,U,4)
- . . ;
- . . I SCCV1ST D ;Chk for gaps from selected start dt to 1st date
- . . . IF SCCVDT<SCCVLDT S SCCVGAP=" " Q
- . . . S SCCV1ST=0
- . . . S SCCVGAP=$S(SCCVLDT'=SCCVDT:"*",1:" ")
- . . . S SCCVLDT=$P(SCCV0,U,4)
- . . ;
- . . D ADDLIST(.SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP)
- ;
- ; Now add any canceled templates
- S SCCVDT=0
- F S SCCVDT=$O(SCCVX(SCCVDT)) Q:'SCCVDT D
- . S SCCVTMP=0 F S SCCVTMP=$O(SCCVX(SCCVDT,SCCVTMP)) Q:'SCCVTMP D
- . . S SCCV0=$G(@SCCVFL@(SCCVTMP,0)),SCCV1=$G(^(1))
- . . D ADDLIST(.SCCVCT,SCCV0,SCCV1," ",SCCVTMP)
- ;
- I '$D(^TMP("SCCV."_SCCVTYP,$J)) S VALMCNT=2,SCCVCT=2,^TMP("SCCV."_SCCVTYP,$J,1,0)=" ",^TMP("SCCV."_SCCVTYP,$J,2,0)=" No Templates On File"
- Q
- ;
- ADDLIST(SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP) ; add to list
- N X,SCCVACT
- S SCCVCT=SCCVCT+1,X="" W "."
- ;
- S X=$$SETFLD^VALM1($J(SCCVCT,4),X,"NUMBER")
- S X=$$SETFLD^VALM1($J(SCCVGAP_$$FMTE^XLFDT($P(SCCV0,U,3),1)_" - "_$$FMTE^XLFDT($P(SCCV0,U,4),1),27),X,"DTRANGE")
- ;
- I SCCVTYP="CST" D ;Conversion templates only
- . S X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.05,$P(SCCV0,U,5)),X,"EVENT")
- . S SCCVACT=$S($P(SCCV0,U,5)=3:"",1:$P(SCCV0,U,7))
- . S X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.07,SCCVACT),X,"ACTION")
- S X=$$SETFLD^VALM1($J(SCCVTMP,5),X,"TEMPLATE")
- ;
- D SET(X)
- Q
- ;
- FNL(SCCVTYP) ; -- Clean up template list
- ; SCCVTYP = 'AST or 'CST' for type of template
- ;
- K ^TMP("SCCV."_SCCVTYP_".DX",$J),^TMP("SCCV."_SCCVTYP,$J)
- K SCCVDONE,SCCVDA,SCCVSCRN
- D CLEAN^VALM10
- Q
- ;
- SET(X) ; -- set arrays for template list
- S VALMCNT=VALMCNT+1,^TMP("SCCV."_SCCVTYP,$J,VALMCNT,0)=X
- S ^TMP("SCCV."_SCCVTYP,$J,"IDX",VALMCNT,SCCVCT)=""
- S ^TMP("SCCV."_SCCVTYP_".DX",$J,SCCVCT)=VALMCNT_"^"_SCCVTMP
- Q
- ;
- SELX(SCCVTYP,CANCEL) ; -- Select the entry to process
- ; SCCVTYP = 'AST or 'CST' for type of template
- ; CANCEL = Flag ... 1 = don't allow to be selected if canceled
- ; 0 = allow to be selected even if canceled
- ;
- D EN^VALM2($G(XQORNOD(0)),"S")
- S SCCVDA=$P($G(^TMP("SCCV."_SCCVTYP_".DX",$J,+$O(VALMY("")))),U,2)
- I $G(CANCEL),$S(SCCVTYP="AST":$P($G(^SD(404.99,+SCCVDA,0)),U,5)=6,1:$P($G(^SD(404.98,+SCCVDA,0)),U,9)) D
- .W !,"You cannot select a canceled template!"
- .D PAUSE^SCCVU
- .K SCCVDA
- Q
- ;
- FNLX ; Clean up after select action
- K SCCVDA
- D CLEAN^VALM10
- S VALMBCK="R"
- Q
- ;
- HDRX ; -- Hdr for select action
- S VALMHDR(1)=" "
- S VALMHDR(2)=SCCVTYP_" #: "_$G(SCCVDA)
- Q
- ;
- FASTEX ; -- Sets a flag that system should be exited
- S VALMBCK="Q"
- I $G(VALMEVL) D ;Ask this for all but the last level
- .D FULL^VALM1
- .N DIR
- .S DIR(0)="Y"
- .S DIR("A")="Exit option entirely"
- .S DIR("B")="NO"
- .D ^DIR
- .I $D(DIRUT)!(Y) S SCFASTXT=1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCCVDSP 3852 printed Jan 18, 2025@03:39:46 Page 2
- SCCVDSP ; ALB/TMP - SCHED VSTS CONVERT/ARCHIVE - TEMPLATE LISTS ; 25-NOV-97
- +1 ;;5.3;Scheduling;**211**;Aug 13, 1993
- +2 ;
- BLD(SCCVTYP) ; -- build list of template entries
- +1 ; SCCVTYP = 'AST or 'CST' for type of template
- +2 ;
- +3 KILL ^TMP("SCCV."_SCCVTYP,$JOB),^TMP("SCCV."_SCCVTYP_".DX",$JOB)
- +4 NEW SCCVFL,SCCVFIL,SCCVTMP,SCCV0,SCCV1,SCCVCT,SCCVDT,SCCVLDT,SCCVGAP,SCCVX
- +5 NEW SCCV1ST,SCCVCAN
- +6 SET (SCCVCT,VALMCNT)=0
- SET SCCVSCRN=1
- +7 SET SCCVFIL=$SELECT(SCCVTYP="CST":404.98,1:404.99)
- +8 SET SCCVCAN=+$PIECE($GET(^SD(404.91,1,"CNV")),U,9)
- +9 ;
- +10 ; -- find all templates
- +11 SET SCCVFL="^SD("_SCCVFIL_")"
- +12 ;
- +13 SET SCCV1ST=1
- +14 SET SCCVGAP=" "
- +15 SET SCCVDT=0
- SET SCCVLDT=+$GET(^SD(404.91,1,"CNV"))
- +16 ;
- +17 FOR
- SET SCCVDT=$ORDER(@SCCVFL@("C",SCCVDT))
- if 'SCCVDT
- QUIT
- Begin DoDot:1
- +18 SET SCCVTMP=0
- FOR
- SET SCCVTMP=$ORDER(@SCCVFL@("C",SCCVDT,SCCVTMP))
- if 'SCCVTMP
- QUIT
- SET SCCV0=$GET(@SCCVFL@(SCCVTMP,0))
- SET SCCV1=$GET(^(1))
- Begin DoDot:2
- +19 ; if cancelled and should be listed ... list last
- +20 IF $PIECE(SCCV0,U,9)
- if SCCVCAN
- SET SCCVX(SCCVDT,SCCVTMP)=""
- QUIT
- +21 ;
- +22 ; -- Check for gaps
- +23 ;Chk for date gaps between templates
- IF 'SCCV1ST
- Begin DoDot:3
- +24 SET SCCVGAP=$SELECT($$FMADD^XLFDT(SCCVLDT,1)=SCCVDT:" ",1:"*")
- +25 SET SCCVLDT=$PIECE(SCCV0,U,4)
- End DoDot:3
- +26 ;
- +27 ;Chk for gaps from selected start dt to 1st date
- IF SCCV1ST
- Begin DoDot:3
- +28 IF SCCVDT<SCCVLDT
- SET SCCVGAP=" "
- QUIT
- +29 SET SCCV1ST=0
- +30 SET SCCVGAP=$SELECT(SCCVLDT'=SCCVDT:"*",1:" ")
- +31 SET SCCVLDT=$PIECE(SCCV0,U,4)
- End DoDot:3
- +32 ;
- +33 DO ADDLIST(.SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP)
- End DoDot:2
- End DoDot:1
- +34 ;
- +35 ; Now add any canceled templates
- +36 SET SCCVDT=0
- +37 FOR
- SET SCCVDT=$ORDER(SCCVX(SCCVDT))
- if 'SCCVDT
- QUIT
- Begin DoDot:1
- +38 SET SCCVTMP=0
- FOR
- SET SCCVTMP=$ORDER(SCCVX(SCCVDT,SCCVTMP))
- if 'SCCVTMP
- QUIT
- Begin DoDot:2
- +39 SET SCCV0=$GET(@SCCVFL@(SCCVTMP,0))
- SET SCCV1=$GET(^(1))
- +40 DO ADDLIST(.SCCVCT,SCCV0,SCCV1," ",SCCVTMP)
- End DoDot:2
- End DoDot:1
- +41 ;
- +42 IF '$DATA(^TMP("SCCV."_SCCVTYP,$JOB))
- SET VALMCNT=2
- SET SCCVCT=2
- SET ^TMP("SCCV."_SCCVTYP,$JOB,1,0)=" "
- SET ^TMP("SCCV."_SCCVTYP,$JOB,2,0)=" No Templates On File"
- +43 QUIT
- +44 ;
- ADDLIST(SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP) ; add to list
- +1 NEW X,SCCVACT
- +2 SET SCCVCT=SCCVCT+1
- SET X=""
- WRITE "."
- +3 ;
- +4 SET X=$$SETFLD^VALM1($JUSTIFY(SCCVCT,4),X,"NUMBER")
- +5 SET X=$$SETFLD^VALM1($JUSTIFY(SCCVGAP_$$FMTE^XLFDT($PIECE(SCCV0,U,3),1)_" - "_$$FMTE^XLFDT($PIECE(SCCV0,U,4),1),27),X,"DTRANGE")
- +6 ;
- +7 ;Conversion templates only
- IF SCCVTYP="CST"
- Begin DoDot:1
- +8 SET X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.05,$PIECE(SCCV0,U,5)),X,"EVENT")
- +9 SET SCCVACT=$SELECT($PIECE(SCCV0,U,5)=3:"",1:$PIECE(SCCV0,U,7))
- +10 SET X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.07,SCCVACT),X,"ACTION")
- End DoDot:1
- +11 SET X=$$SETFLD^VALM1($JUSTIFY(SCCVTMP,5),X,"TEMPLATE")
- +12 ;
- +13 DO SET(X)
- +14 QUIT
- +15 ;
- FNL(SCCVTYP) ; -- Clean up template list
- +1 ; SCCVTYP = 'AST or 'CST' for type of template
- +2 ;
- +3 KILL ^TMP("SCCV."_SCCVTYP_".DX",$JOB),^TMP("SCCV."_SCCVTYP,$JOB)
- +4 KILL SCCVDONE,SCCVDA,SCCVSCRN
- +5 DO CLEAN^VALM10
- +6 QUIT
- +7 ;
- SET(X) ; -- set arrays for template list
- +1 SET VALMCNT=VALMCNT+1
- SET ^TMP("SCCV."_SCCVTYP,$JOB,VALMCNT,0)=X
- +2 SET ^TMP("SCCV."_SCCVTYP,$JOB,"IDX",VALMCNT,SCCVCT)=""
- +3 SET ^TMP("SCCV."_SCCVTYP_".DX",$JOB,SCCVCT)=VALMCNT_"^"_SCCVTMP
- +4 QUIT
- +5 ;
- SELX(SCCVTYP,CANCEL) ; -- Select the entry to process
- +1 ; SCCVTYP = 'AST or 'CST' for type of template
- +2 ; CANCEL = Flag ... 1 = don't allow to be selected if canceled
- +3 ; 0 = allow to be selected even if canceled
- +4 ;
- +5 DO EN^VALM2($GET(XQORNOD(0)),"S")
- +6 SET SCCVDA=$PIECE($GET(^TMP("SCCV."_SCCVTYP_".DX",$JOB,+$ORDER(VALMY("")))),U,2)
- +7 IF $GET(CANCEL)
- IF $SELECT(SCCVTYP="AST":$PIECE($GET(^SD(404.99,+SCCVDA,0)),U,5)=6,1:$PIECE($GET(^SD(404.98,+SCCVDA,0)),U,9))
- Begin DoDot:1
- +8 WRITE !,"You cannot select a canceled template!"
- +9 DO PAUSE^SCCVU
- +10 KILL SCCVDA
- End DoDot:1
- +11 QUIT
- +12 ;
- FNLX ; Clean up after select action
- +1 KILL SCCVDA
- +2 DO CLEAN^VALM10
- +3 SET VALMBCK="R"
- +4 QUIT
- +5 ;
- HDRX ; -- Hdr for select action
- +1 SET VALMHDR(1)=" "
- +2 SET VALMHDR(2)=SCCVTYP_" #: "_$GET(SCCVDA)
- +3 QUIT
- +4 ;
- FASTEX ; -- Sets a flag that system should be exited
- +1 SET VALMBCK="Q"
- +2 ;Ask this for all but the last level
- IF $GET(VALMEVL)
- Begin DoDot:1
- +3 DO FULL^VALM1
- +4 NEW DIR
- +5 SET DIR(0)="Y"
- +6 SET DIR("A")="Exit option entirely"
- +7 SET DIR("B")="NO"
- +8 DO ^DIR
- +9 IF $DATA(DIRUT)!(Y)
- SET SCFASTXT=1
- End DoDot:1
- +10 QUIT
- +11 ;